diff --git a/cabal.project.freeze b/cabal.project.freeze index 32dcd9462be..ac989026432 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -241,6 +241,7 @@ constraints: any.Cabal ==3.2.1.0, any.quickcheck-instances ==0.3.27, any.quickcheck-io ==0.2.0, any.random ==1.2.1, + any.refined ==0.7, any.reflection ==2.1.6, any.regex-base ==0.94.0.2, 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-reify-many ==0.1.10, any.these ==1.1.1.1, + any.these-skinny ==0.7.5, any.time ==1.9.3, any.time-compat ==1.9.6.1, any.time-locale-compat ==0.1.1.5, diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 92a4afcb590..ddb80cf45e1 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -186,6 +186,7 @@ common lib-depends , pretty-simple , process , profunctors + , refined , retry , safe-exceptions , scientific @@ -683,7 +684,6 @@ library , Hasura.RQL.Types.Metadata.Object , Hasura.RQL.Types.Metadata.Serialization , Hasura.RQL.Types.Network - , Hasura.RQL.Types.Numeric , Hasura.RQL.Types.Permission , Hasura.RQL.Types.QueryCollection , Hasura.RQL.Types.QueryTags @@ -900,6 +900,7 @@ executable graphql-engine , hasura-prelude , kan-extensions , pg-client + , refined , text , text-conversions , time @@ -1010,7 +1011,6 @@ test-suite graphql-engine-tests Control.Monad.MemoizeSpec Control.Monad.TimeLimit Data.HashMap.Strict.ExtendedSpec - Data.NumericSpec Data.Parser.CacheControlSpec Data.Parser.JSONPathSpec Data.Parser.RemoteRelationshipSpec diff --git a/server/src-lib/Hasura/App.hs b/server/src-lib/Hasura/App.hs index e3721908d73..c23a6c3fb33 100644 --- a/server/src-lib/Hasura/App.hs +++ b/server/src-lib/Hasura/App.hs @@ -110,7 +110,6 @@ import Hasura.RQL.Types.Common import Hasura.RQL.Types.Eventing.Backend import Hasura.RQL.Types.Metadata import Hasura.RQL.Types.Network -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.RQL.Types.SchemaCache import Hasura.RQL.Types.SchemaCache.Build import Hasura.RQL.Types.Source @@ -148,6 +147,7 @@ import Network.HTTP.Client.Transformable qualified as HTTP import Network.Wai (Application) import Network.Wai.Handler.Warp qualified as Warp import Options.Applicative +import Refined (unrefine) import System.Environment (getEnvironment) import System.Log.FastLogger qualified as FL 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)) startEventTriggerPollerThread logger lockedEventsCtx cacheRef = do - let maxEventThreads = Numeric.getPositiveInt soEventsHttpPoolSize - fetchInterval = milliseconds $ Numeric.getNonNegative soEventsFetchInterval + let maxEventThreads = unrefine soEventsHttpPoolSize + fetchInterval = milliseconds $ unrefine soEventsFetchInterval 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 -- prepare event triggers data eventEngineCtx <- liftIO $ atomically $ initEventEngineCtx maxEventThreads fetchInterval soEventsFetchBatchSize @@ -929,7 +929,7 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook "event_triggers" (length <$> readTVarIO (leEvents lockedEventsCtx)) (EventTriggerShutdownAction (shutdownEventTriggerEvents allSources logger lockedEventsCtx)) - (Numeric.getNonNegative soGracefulShutdownTimeout) + (unrefine soGracefulShutdownTimeout) unLogger logger $ mkGenericStrLog LevelInfo "event_triggers" "starting workers" void $ C.forkManagedTWithGracefulShutdown @@ -950,7 +950,7 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook -- start a background thread to handle async actions case soAsyncActionsFetchInterval of Skip -> pure () -- Don't start the poller thread - Interval (Numeric.getNonNegative -> sleepTime) -> do + Interval (unrefine -> sleepTime) -> do let label = "asyncActionsProcessor" asyncActionGracefulShutdownAction = ( liftWithStateless \lowerIO -> @@ -959,7 +959,7 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook "async_actions" (length <$> readTVarIO (leActionEvents lockedEventsCtx)) (MetadataDBShutdownAction (hoist lowerIO (shutdownAsyncActions lockedEventsCtx))) - (Numeric.getNonNegative soGracefulShutdownTimeout) + (unrefine soGracefulShutdownTimeout) ) ) @@ -995,7 +995,7 @@ mkHGEServer setupHook env ServeOptions {..} ServeCtx {..} initTime postPollHook "scheduled_events" (getProcessingScheduledEventsCount lockedEventsCtx) (MetadataDBShutdownAction (hoist lowerIO unlockAllLockedScheduledEvents)) - (Numeric.getNonNegative soGracefulShutdownTimeout) + (unrefine soGracefulShutdownTimeout) ) ) diff --git a/server/src-lib/Hasura/Base/Instances.hs b/server/src-lib/Hasura/Base/Instances.hs index 8b9d688de8c..6bf451797f4 100644 --- a/server/src-lib/Hasura/Base/Instances.hs +++ b/server/src-lib/Hasura/Base/Instances.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | This module defines all missing instances of third party libraries. @@ -6,13 +7,16 @@ module Hasura.Base.Instances () where import Control.Monad.Fix import Data.Aeson qualified as J +import Data.Fixed (Fixed (..)) import Data.Functor.Product (Product (Pair)) import "some" Data.GADT.Compare (GCompare (gcompare), GOrdering (GEQ, GGT, GLT)) import Data.OpenApi.Declare as D import Data.Text qualified as T +import Data.Time (NominalDiffTime) import Data.URL.Template qualified as UT import Database.PG.Query qualified as PG import Hasura.Prelude +import Language.Haskell.TH.Lift qualified as TH (deriveLift) import Language.Haskell.TH.Syntax qualified as TH import System.Cron.Parser 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 (Fixed a) + deriving instance TH.Lift TDFA.PatternSetCharacterClass deriving instance TH.Lift TDFA.PatternSetCollatingElement deriving instance TH.Lift TDFA.PatternSetEquivalenceClass +$(TH.deriveLift ''DiffTime) + +$(TH.deriveLift ''NominalDiffTime) + +deriving instance TH.Lift Milliseconds + +deriving instance TH.Lift Seconds + -------------------------------------------------------------------------------- -- GADT diff --git a/server/src-lib/Hasura/Eventing/EventTrigger.hs b/server/src-lib/Hasura/Eventing/EventTrigger.hs index 1423e2adaad..707d32edb01 100644 --- a/server/src-lib/Hasura/Eventing/EventTrigger.hs +++ b/server/src-lib/Hasura/Eventing/EventTrigger.hs @@ -74,8 +74,6 @@ import Hasura.RQL.Types.Backend import Hasura.RQL.Types.Common import Hasura.RQL.Types.EventTrigger 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.Source import Hasura.SQL.AnyBackend qualified as AB @@ -85,6 +83,7 @@ import Hasura.Server.Prometheus (EventTriggerMetrics (..)) import Hasura.Server.Types import Hasura.Tracing qualified as Tracing 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.Gauge qualified as EKG.Gauge import System.Metrics.Prometheus.Gauge qualified as Prometheus.Gauge @@ -128,7 +127,7 @@ following way now: data EventEngineCtx = EventEngineCtx { _eeCtxEventThreadsCapacity :: TVar Int, _eeCtxFetchInterval :: DiffTime, - _eeCtxFetchSize :: NonNegativeInt + _eeCtxFetchSize :: Refined NonNegative Int } data DeliveryInfo = DeliveryInfo @@ -168,13 +167,13 @@ deriving instance Backend b => Eq (EventPayload b) instance Backend b => J.ToJSON (EventPayload b) where toJSON = J.genericToJSON hasuraJSON {omitNothingFields = True} -defaultMaxEventThreads :: Numeric.PositiveInt -defaultMaxEventThreads = Numeric.unsafePositiveInt 100 +defaultMaxEventThreads :: Refined Positive Int +defaultMaxEventThreads = $$(refineTH 100) defaultFetchInterval :: DiffTime defaultFetchInterval = seconds 1 -initEventEngineCtx :: Int -> DiffTime -> NonNegativeInt -> STM EventEngineCtx +initEventEngineCtx :: Int -> DiffTime -> Refined NonNegative Int -> STM EventEngineCtx initEventEngineCtx maxT _eeCtxFetchInterval _eeCtxFetchSize = do _eeCtxEventThreadsCapacity <- newTVar maxT return $ EventEngineCtx {..} @@ -230,7 +229,7 @@ processEventQueue logger httpMgr getSchemaCache EventEngineCtx {..} LockedEvents events0 <- popEventsBatch return $ Forever (events0, 0, False) go where - fetchBatchSize = Numeric.getNonNegativeInt _eeCtxFetchSize + fetchBatchSize = unrefine _eeCtxFetchSize popEventsBatch :: m [BackendEventWithSource] popEventsBatch = do diff --git a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs index a3388c875b9..da6211cee65 100644 --- a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs +++ b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs @@ -144,12 +144,12 @@ import Hasura.RQL.DDL.Webhook.Transform import Hasura.RQL.Types.Common import Hasura.RQL.Types.EventTrigger import Hasura.RQL.Types.Eventing -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.RQL.Types.ScheduledTrigger import Hasura.RQL.Types.SchemaCache import Hasura.SQL.Types import Hasura.Tracing qualified as Tracing import Network.HTTP.Client.Transformable qualified as HTTP +import Refined (unrefine) import Text.Builder qualified as TB -- | runCronEventsGenerator makes sure that all the cron triggers @@ -358,13 +358,10 @@ processScheduledEvent eventId eventHeaders retryCtx payload webhookUrl type' = let retryConf = _rctxConf retryCtx scheduledTime = sewpScheduledTime payload if convertDuration (diffUTCTime currentTime scheduledTime) - > Numeric.unNonNegativeDiffTime (strcToleranceSeconds retryConf) + > unrefine (strcToleranceSeconds retryConf) then processDead eventId type' else do - let timeoutSeconds = - round $ - Numeric.unNonNegativeDiffTime $ - strcTimeoutSeconds retryConf + let timeoutSeconds = round $ unrefine (strcTimeoutSeconds retryConf) httpTimeout = HTTP.responseTimeoutMicro (timeoutSeconds * 1000000) (headers, decodedHeaders) = prepareHeaders eventHeaders extraLogCtx = ExtraLogContext eventId (sewpName payload) @@ -442,9 +439,7 @@ retryOrMarkError eventId retryCtx err type' = do currentTime <- liftIO getCurrentTime let delay = fromMaybe - ( round $ - Numeric.unNonNegativeDiffTime $ - strcRetryIntervalSeconds retryConf + ( round $ unrefine (strcRetryIntervalSeconds retryConf) ) mRetryHeaderSeconds diff = fromIntegral delay diff --git a/server/src-lib/Hasura/GraphQL/Execute/Subscription/Options.hs b/server/src-lib/Hasura/GraphQL/Execute/Subscription/Options.hs index c7142581009..04a4cc77b60 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Subscription/Options.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Subscription/Options.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + module Hasura.GraphQL.Execute.Subscription.Options ( SubscriptionsOptions (..), LiveQueriesOptions, @@ -11,9 +13,9 @@ module Hasura.GraphQL.Execute.Subscription.Options where import Data.Aeson qualified as J +import Hasura.Base.Instances () import Hasura.Prelude -import Hasura.RQL.Types.Numeric (NonNegativeDiffTime, NonNegativeInt) -import Hasura.RQL.Types.Numeric qualified as Numeric +import Refined (NonNegative, Refined, refineFail, refineTH) data SubscriptionsOptions = SubscriptionsOptions { _lqoBatchSize :: !BatchSize, @@ -28,8 +30,8 @@ type StreamQueriesOptions = SubscriptionsOptions mkSubscriptionsOptions :: Maybe BatchSize -> Maybe RefetchInterval -> SubscriptionsOptions mkSubscriptionsOptions batchSize refetchInterval = SubscriptionsOptions - { _lqoBatchSize = fromMaybe (BatchSize $ Numeric.unsafeNonNegativeInt 100) batchSize, - _lqoRefetchInterval = fromMaybe (RefetchInterval 1) refetchInterval + { _lqoBatchSize = fromMaybe (BatchSize $$(refineTH 100)) batchSize, + _lqoRefetchInterval = fromMaybe (RefetchInterval $$(refineTH 1)) refetchInterval } instance J.ToJSON SubscriptionsOptions where @@ -44,16 +46,16 @@ instance J.FromJSON SubscriptionsOptions where SubscriptionsOptions <$> o J..: "batch_size" <*> o J..: "refetch_delay" -newtype BatchSize = BatchSize {unBatchSize :: NonNegativeInt} +newtype BatchSize = BatchSize {unBatchSize :: Refined NonNegative Int} deriving (Show, Eq, J.ToJSON, J.FromJSON) 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. -- 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) mkRefetchInterval :: DiffTime -> Maybe RefetchInterval -mkRefetchInterval x = RefetchInterval <$> Numeric.mkNonNegativeDiffTime x +mkRefetchInterval x = RefetchInterval <$> refineFail x diff --git a/server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/LiveQuery.hs b/server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/LiveQuery.hs index e3938305eeb..109bf8df68b 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/LiveQuery.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/LiveQuery.hs @@ -29,9 +29,9 @@ import Hasura.GraphQL.Transport.HTTP.Protocol import Hasura.Prelude import Hasura.RQL.Types.Backend import Hasura.RQL.Types.Common (SourceName) -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.RQL.Types.Subscription (SubscriptionType (..)) import Hasura.Session +import Refined (unrefine) pushResultToCohort :: GQResult BS.ByteString -> @@ -90,7 +90,7 @@ pollLiveQuery pollerId lqOpts (sourceName, sourceConfig) roleName parameterizedQ cohorts <- STM.atomically $ TMap.toList cohortMap cohortSnapshots <- mapM (STM.atomically . getCohortSnapshot) cohorts -- 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 pure $ zip (BatchId <$> [1 ..]) cohortBatches diff --git a/server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/StreamingQuery.hs b/server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/StreamingQuery.hs index 8d3bbcf808d..53b45edfd46 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/StreamingQuery.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Subscription/Poll/StreamingQuery.hs @@ -33,11 +33,11 @@ import Hasura.GraphQL.Transport.HTTP.Protocol import Hasura.Prelude import Hasura.RQL.Types.Backend import Hasura.RQL.Types.Common (SourceName) -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.RQL.Types.Subscription (SubscriptionType (..)) import Hasura.SQL.Value (TxtEncodedVal (..)) import Hasura.Session import Language.GraphQL.Draft.Syntax qualified as G +import Refined (unrefine) import Text.Shakespeare.Text (st) {- Note [Streaming subscriptions rebuilding cohort map] @@ -250,7 +250,7 @@ pollStreamingQuery pollerId lqOpts (sourceName, sourceConfig) roleName parameter cohorts <- STM.atomically $ TMap.toList cohortMap cohortSnapshots <- mapM (STM.atomically . getCohortSnapshot) cohorts -- 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 pure $ zip (BatchId <$> [1 ..]) cohortBatches diff --git a/server/src-lib/Hasura/GraphQL/Execute/Subscription/State.hs b/server/src-lib/Hasura/GraphQL/Execute/Subscription/State.hs index 8dedb0fed45..f4a1b8811dd 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Subscription/State.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Subscription/State.hs @@ -49,11 +49,11 @@ import Hasura.Logging qualified as L import Hasura.Prelude import Hasura.RQL.Types.Action import Hasura.RQL.Types.Common (SourceName) -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.Server.Metrics (ServerMetrics (..)) import Hasura.Server.Prometheus (PrometheusMetrics (..)) import Hasura.Server.Types (RequestId) import Language.GraphQL.Draft.Syntax qualified as G +import Refined (unrefine) import StmContainers.Map qualified as STMMap import System.Metrics.Gauge qualified as EKG.Gauge import System.Metrics.Prometheus.Gauge qualified as Prometheus.Gauge @@ -198,7 +198,7 @@ addLiveQuery threadRef <- forkImmortal ("pollLiveQuery." <> show pollerId) logger $ forever $ do 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 $assertNFHere pState -- so we don't write thunks to mutable vars STM.atomically $ STM.putTMVar (_pIOState poller) pState @@ -288,7 +288,7 @@ addStreamSubscriptionQuery threadRef <- forkImmortal ("pollStreamingQuery." <> show (unPollerId pollerId)) logger $ forever $ do 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 $assertNFHere pState -- so we don't write thunks to mutable vars STM.atomically $ STM.putTMVar (_pIOState handler) pState diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs index 23b643bea05..f452e5fdb0c 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs @@ -65,7 +65,6 @@ import Hasura.GraphQL.Transport.WebSocket.Types import Hasura.Logging qualified as L import Hasura.Metadata.Class import Hasura.Prelude -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.RQL.Types.RemoteSchema import Hasura.RQL.Types.ResultCustomization import Hasura.RQL.Types.SchemaCache (scApiLimits) @@ -96,6 +95,7 @@ import ListT qualified import Network.HTTP.Client qualified as HTTP import Network.HTTP.Types qualified as HTTP import Network.WebSockets qualified as WS +import Refined (unrefine) import StmContainers.Map qualified as STMMap import System.Metrics.Prometheus.Counter qualified as Prometheus.Counter import System.Metrics.Prometheus.Histogram qualified as Prometheus.Histogram @@ -299,7 +299,7 @@ onConn wsId requestHead ipAddress onConnHActions = do liftIO $ forever $ do kaAction wsConn - sleep $ seconds (Numeric.getNonNegative $ unKeepAliveDelay keepAliveDelay) + sleep $ seconds (unrefine $ unKeepAliveDelay keepAliveDelay) tokenExpiryHandler wsConn = do expTime <- liftIO $ diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs index 967f3944c89..b32f87fc2fd 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs @@ -57,11 +57,11 @@ import Hasura.GraphQL.Transport.HTTP.Protocol import Hasura.GraphQL.Transport.WebSocket.Protocol import Hasura.Logging qualified as L import Hasura.Prelude -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.Server.Init.Config (WSConnectionInitTimeout (..)) import ListT qualified import Network.Wai.Extended (IpAddress) import Network.WebSockets qualified as WS +import Refined (unrefine) import StmContainers.Map qualified as STMMap 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 -- 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 - wsConnInitTimer <- liftIO $ getNewWSTimer (Numeric.getNonNegative $ unWSConnectionInitTimeout wsConnInitTimeout) + wsConnInitTimer <- liftIO $ getNewWSTimer (unrefine $ unWSConnectionInitTimeout wsConnInitTimeout) status <- liftIO $ STM.readTVarIO serverStatus case status of AcceptingConns _ -> logUnexpectedExceptions $ do diff --git a/server/src-lib/Hasura/Incremental/Internal/Dependency.hs b/server/src-lib/Hasura/Incremental/Internal/Dependency.hs index 77a9b720042..5634078f7a4 100644 --- a/server/src-lib/Hasura/Incremental/Internal/Dependency.hs +++ b/server/src-lib/Hasura/Incremental/Internal/Dependency.hs @@ -51,6 +51,7 @@ import Hasura.Incremental.Select import Hasura.Prelude import Language.GraphQL.Draft.Syntax qualified as G import Network.URI.Extended qualified as N +import Refined (Refined, unrefine) import Servant.Client (BaseUrl, Scheme) import System.Cron.Types @@ -127,6 +128,9 @@ class (Eq a) => Cacheable a where instance (Cacheable a) => Cacheable (NESeq a) where 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. newtype Accesses = Accesses {unAccesses :: DM.DMap UniqueS Access} diff --git a/server/src-lib/Hasura/RQL/Types/Numeric.hs b/server/src-lib/Hasura/RQL/Types/Numeric.hs deleted file mode 100644 index 92b3d506eb2..00000000000 --- a/server/src-lib/Hasura/RQL/Types/Numeric.hs +++ /dev/null @@ -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" diff --git a/server/src-lib/Hasura/RQL/Types/ScheduledTrigger.hs b/server/src-lib/Hasura/RQL/Types/ScheduledTrigger.hs index 3f4cabc6fad..4c2738cf25f 100644 --- a/server/src-lib/Hasura/RQL/Types/ScheduledTrigger.hs +++ b/server/src-lib/Hasura/RQL/Types/ScheduledTrigger.hs @@ -61,8 +61,8 @@ import Hasura.RQL.DDL.Webhook.Transform (MetadataResponseTransform, RequestTrans import Hasura.RQL.Types.Common (InputWebhook (..)) import Hasura.RQL.Types.EventTrigger import Hasura.RQL.Types.Eventing -import Hasura.RQL.Types.Numeric (NonNegativeDiffTime, unsafeNonNegativeDiffTime) import PostgreSQL.Binary.Decoding qualified as PD +import Refined (NonNegative, Refined, refineTH) import System.Cron.Types type CronEventId = EventId @@ -75,14 +75,14 @@ type InvocationId = Text data STRetryConf = STRetryConf { strcNumRetries :: Int, - strcRetryIntervalSeconds :: NonNegativeDiffTime, - strcTimeoutSeconds :: NonNegativeDiffTime, + strcRetryIntervalSeconds :: Refined NonNegative DiffTime, + strcTimeoutSeconds :: Refined NonNegative DiffTime, -- | 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 -- difference between the current timestamp and the scheduled event's -- timestamp, if the age is than the tolerance then the scheduled event -- is marked as dead. - strcToleranceSeconds :: NonNegativeDiffTime + strcToleranceSeconds :: Refined NonNegative DiffTime } deriving (Show, Eq, Generic) @@ -94,11 +94,11 @@ instance FromJSON STRetryConf where parseJSON = withObject "STRetryConf" \o -> do numRetries' <- o .:? "num_retries" .!= 0 retryInterval <- - o .:? "retry_interval_seconds" .!= unsafeNonNegativeDiffTime (seconds 10) + o .:? "retry_interval_seconds" .!= $$(refineTH @NonNegative @DiffTime (seconds 10)) timeout <- - o .:? "timeout_seconds" .!= unsafeNonNegativeDiffTime (seconds 60) + o .:? "timeout_seconds" .!= $$(refineTH @NonNegative @DiffTime (seconds 60)) tolerance <- - o .:? "tolerance_seconds" .!= unsafeNonNegativeDiffTime (hours 6) + o .:? "tolerance_seconds" .!= $$(refineTH @NonNegative @DiffTime (hours 6)) if numRetries' < 0 then fail "num_retries cannot be a negative value" else pure $ STRetryConf numRetries' retryInterval timeout tolerance @@ -109,9 +109,9 @@ defaultSTRetryConf :: STRetryConf defaultSTRetryConf = STRetryConf { strcNumRetries = 0, - strcRetryIntervalSeconds = unsafeNonNegativeDiffTime $ seconds 10, - strcTimeoutSeconds = unsafeNonNegativeDiffTime $ seconds 60, - strcToleranceSeconds = unsafeNonNegativeDiffTime $ hours 6 + strcRetryIntervalSeconds = $$(refineTH (seconds 10)), + strcTimeoutSeconds = $$(refineTH (seconds 60)), + strcToleranceSeconds = $$(refineTH (hours 6)) } data CronTriggerMetadata = CronTriggerMetadata diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index cfe442bc873..58d85026536 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -36,7 +36,6 @@ import Hasura.GraphQL.Schema.Options qualified as Options import Hasura.Logging qualified as Logging import Hasura.Prelude 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.Cors qualified as Cors 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.Types qualified as Types import Network.WebSockets qualified as WebSockets +import Refined (unrefine) -------------------------------------------------------------------------------- -- TODO(SOLOMON): Where does this note belong? @@ -207,19 +207,19 @@ mkServeOptions ServeOptionsRaw {..} = do pure ServeOptions {..} where 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 -- hard throughput cap at 1000RPS when db queries take 50ms on average: - cpConns <- Numeric.getNonNegativeInt <$> withOptionDefault rcpConns pgConnsOption - cpIdleTime <- Numeric.getNonNegativeInt <$> withOptionDefault rcpIdleTime pgTimeoutOption + cpConns <- unrefine <$> withOptionDefault rcpConns pgConnsOption + cpIdleTime <- unrefine <$> withOptionDefault rcpIdleTime pgTimeoutOption cpAllowPrepare <- withOptionDefault rcpAllowPrepare pgUsePreparedStatementsOption -- TODO: Add newtype to allow this: cpMbLifetime <- do - lifetime <- Numeric.getNonNegative <$> withOptionDefault rcpConnLifetime pgConnLifetimeOption + lifetime <- unrefine <$> withOptionDefault rcpConnLifetime pgConnLifetimeOption if lifetime == 0 then pure Nothing else pure (Just lifetime) - cpTimeout <- fmap Numeric.getNonNegative <$> withOption rcpPoolTimeout pgPoolTimeoutOption + cpTimeout <- fmap unrefine <$> withOption rcpPoolTimeout pgPoolTimeoutOption let cpCancel = True return $ Query.ConnParams {..} diff --git a/server/src-lib/Hasura/Server/Init/Arg/Command/Serve.hs b/server/src-lib/Hasura/Server/Init/Arg/Command/Serve.hs index 55d9257f80a..1890e9f9d5b 100644 --- a/server/src-lib/Hasura/Server/Init/Arg/Command/Serve.hs +++ b/server/src-lib/Hasura/Server/Init/Arg/Command/Serve.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + -- | The Arg Opt.Parser for the 'serve' subcommand. module Hasura.Server.Init.Arg.Command.Serve ( -- * Opt.Parser @@ -72,7 +74,6 @@ import Hasura.GraphQL.Schema.NamingCase (NamingCase) import Hasura.GraphQL.Schema.Options qualified as Options import Hasura.Logging qualified as Logging import Hasura.Prelude -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.Server.Auth qualified as Auth import Hasura.Server.Cors qualified as Cors 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 Network.Wai.Handler.Warp qualified as Warp import Options.Applicative qualified as Opt +import Refined (NonNegative, Positive, Refined, refineTH) import Witch qualified -------------------------------------------------------------------------------- @@ -176,7 +178,7 @@ parseConnParams :: Opt.Parser Config.ConnParamsRaw parseConnParams = Config.ConnParamsRaw <$> pgStripes <*> pgConns <*> pgIdleTimeout <*> pgConnLifetime <*> pgUsePreparedStatements <*> pgPoolTimeout where - pgStripes :: Opt.Parser (Maybe Numeric.NonNegativeInt) + pgStripes :: Opt.Parser (Maybe (Refined NonNegative Int)) pgStripes = Opt.optional $ Opt.option @@ -187,7 +189,7 @@ parseConnParams = <> Opt.help (Config._helpMessage pgStripesOption) ) - pgConns :: Opt.Parser (Maybe Numeric.NonNegativeInt) + pgConns :: Opt.Parser (Maybe (Refined NonNegative Int)) pgConns = Opt.optional $ Opt.option @@ -198,7 +200,7 @@ parseConnParams = <> Opt.help (Config._helpMessage pgConnsOption) ) - pgIdleTimeout :: Opt.Parser (Maybe Numeric.NonNegativeInt) + pgIdleTimeout :: Opt.Parser (Maybe (Refined NonNegative Int)) pgIdleTimeout = Opt.optional $ Opt.option @@ -208,7 +210,7 @@ parseConnParams = <> Opt.help (Config._helpMessage pgTimeoutOption) ) - pgConnLifetime :: Opt.Parser (Maybe (Numeric.NonNegative Time.NominalDiffTime)) + pgConnLifetime :: Opt.Parser (Maybe (Refined NonNegative Time.NominalDiffTime)) pgConnLifetime = Opt.optional $ Opt.option @@ -228,7 +230,7 @@ parseConnParams = <> Opt.help (Config._helpMessage pgUsePreparedStatementsOption) ) - pgPoolTimeout :: Opt.Parser (Maybe (Numeric.NonNegative Time.NominalDiffTime)) + pgPoolTimeout :: Opt.Parser (Maybe (Refined NonNegative Time.NominalDiffTime)) pgPoolTimeout = Opt.optional $ Opt.option @@ -238,20 +240,20 @@ parseConnParams = <> Opt.help (Config._helpMessage pgPoolTimeoutOption) ) -pgStripesOption :: Config.Option Numeric.NonNegativeInt +pgStripesOption :: Config.Option (Refined NonNegative Int) pgStripesOption = Config.Option - { _default = Numeric.unsafeNonNegativeInt 1, + { _default = $$(refineTH 1), _envVar = "HASURA_GRAPHQL_PG_STRIPES", _helpMessage = "Number of stripes (distinct sub-pools) to maintain with Postgres (default: 1). " <> "New connections will be taken from a particular stripe pseudo-randomly." } -pgConnsOption :: Config.Option Numeric.NonNegativeInt +pgConnsOption :: Config.Option (Refined NonNegative Int) pgConnsOption = Config.Option - { _default = Numeric.unsafeNonNegativeInt 50, + { _default = $$(refineTH 50), _envVar = "HASURA_GRAPHQL_PG_CONNECTIONS", _helpMessage = "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." } -pgTimeoutOption :: Config.Option Numeric.NonNegativeInt +pgTimeoutOption :: Config.Option (Refined NonNegative Int) pgTimeoutOption = Config.Option - { _default = Numeric.unsafeNonNegativeInt 180, + { _default = $$(refineTH 180), _envVar = "HASURA_GRAPHQL_PG_TIMEOUT", _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 = Config.Option - { _default = Numeric.unsafeNonNegative 600, + { _default = $$(refineTH 600), _envVar = "HASURA_GRAPHQL_PG_CONN_LIFETIME", _helpMessage = "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 - { Config._default = Subscription.Options.RefetchInterval 1, + { Config._default = Subscription.Options.RefetchInterval $$(refineTH 1), Config._envVar = "HASURA_GRAPHQL_LIVE_QUERIES_MULTIPLEXED_REFETCH_INTERVAL", Config._helpMessage = "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 - { _default = Subscription.Options.BatchSize $ Numeric.unsafeNonNegativeInt 100, + { _default = Subscription.Options.BatchSize $$(refineTH 100), _envVar = "HASURA_GRAPHQL_LIVE_QUERIES_MULTIPLEXED_BATCH_SIZE", _helpMessage = "multiplexed live queries are split into batches of the specified " @@ -645,7 +647,7 @@ parseStreamingMxRefetchDelay = streamingMxRefetchDelayOption :: Config.Option Subscription.Options.RefetchInterval streamingMxRefetchDelayOption = 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._helpMessage = "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 - { 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._helpMessage = "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)" } -parseGraphqlEventsHttpPoolSize :: Opt.Parser (Maybe Numeric.PositiveInt) +parseGraphqlEventsHttpPoolSize :: Opt.Parser (Maybe (Refined Positive Int)) parseGraphqlEventsHttpPoolSize = Opt.optional $ Opt.option @@ -787,15 +789,15 @@ parseGraphqlEventsHttpPoolSize = <> Opt.help (Config._helpMessage graphqlEventsHttpPoolSizeOption) ) -graphqlEventsHttpPoolSizeOption :: Config.Option Numeric.PositiveInt +graphqlEventsHttpPoolSizeOption :: Config.Option (Refined Positive Int) graphqlEventsHttpPoolSizeOption = Config.Option - { Config._default = Numeric.unsafePositiveInt 100, + { Config._default = $$(refineTH 100), Config._envVar = "HASURA_GRAPHQL_EVENTS_HTTP_POOL_SIZE", Config._helpMessage = "Max event processing threads (default: 100)" } -parseGraphqlEventsFetchInterval :: Opt.Parser (Maybe (Numeric.NonNegative Milliseconds)) +parseGraphqlEventsFetchInterval :: Opt.Parser (Maybe (Refined NonNegative Milliseconds)) parseGraphqlEventsFetchInterval = Opt.optional $ Opt.option @@ -805,10 +807,10 @@ parseGraphqlEventsFetchInterval = <> Opt.help (Config._helpMessage graphqlEventsFetchIntervalOption) ) -graphqlEventsFetchIntervalOption :: Config.Option (Numeric.NonNegative Milliseconds) +graphqlEventsFetchIntervalOption :: Config.Option (Refined NonNegative Milliseconds) graphqlEventsFetchIntervalOption = Config.Option - { Config._default = Numeric.unsafeNonNegative (1000 :: Milliseconds), + { Config._default = $$(refineTH 1000), 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)." } @@ -826,7 +828,7 @@ parseGraphqlAsyncActionsFetchInterval = asyncActionsFetchIntervalOption :: Config.Option Config.OptionalInterval asyncActionsFetchIntervalOption = 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._helpMessage = "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._default = Config.KeepAliveDelay $ Numeric.unsafeNonNegative (5 :: Seconds), + { Config._default = Config.KeepAliveDelay $$(refineTH 5), Config._envVar = "HASURA_GRAPHQL_WEBSOCKET_KEEPALIVE", Config._helpMessage = "Control websocket keep-alive timeout (default 5 seconds)" } @@ -930,7 +932,7 @@ schemaPollIntervalOption :: Config.Option Config.OptionalInterval schemaPollIntervalOption = Config.Option { -- 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._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" } -parseEventsFetchBatchSize :: Opt.Parser (Maybe Numeric.NonNegativeInt) +parseEventsFetchBatchSize :: Opt.Parser (Maybe (Refined NonNegative Int)) parseEventsFetchBatchSize = Opt.optional $ Opt.option @@ -969,17 +971,17 @@ parseEventsFetchBatchSize = <> Opt.help (Config._helpMessage eventsFetchBatchSizeOption) ) -eventsFetchBatchSizeOption :: Config.Option Numeric.NonNegativeInt +eventsFetchBatchSizeOption :: Config.Option (Refined NonNegative Int) eventsFetchBatchSizeOption = Config.Option - { Config._default = Numeric.unsafeNonNegativeInt 100, + { Config._default = $$(refineTH 100), Config._envVar = "HASURA_GRAPHQL_EVENTS_FETCH_BATCH_SIZE", Config._helpMessage = "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. " } -parseGracefulShutdownTimeout :: Opt.Parser (Maybe (Numeric.NonNegative Seconds)) +parseGracefulShutdownTimeout :: Opt.Parser (Maybe (Refined NonNegative Seconds)) parseGracefulShutdownTimeout = Opt.optional $ Opt.option @@ -989,10 +991,10 @@ parseGracefulShutdownTimeout = <> Opt.help (Config._helpMessage gracefulShutdownOption) ) -gracefulShutdownOption :: Config.Option (Numeric.NonNegative Seconds) +gracefulShutdownOption :: Config.Option (Refined NonNegative Seconds) gracefulShutdownOption = Config.Option - { Config._default = Numeric.unsafeNonNegative (60 :: Seconds), + { Config._default = $$(refineTH 60), Config._envVar = "HASURA_GRAPHQL_GRACEFUL_SHUTDOWN_TIMEOUT", Config._helpMessage = "Timeout for graceful shutdown before which in-flight scheduled events, " @@ -1012,7 +1014,7 @@ parseWebSocketConnectionInitTimeout = webSocketConnectionInitTimeoutOption :: Config.Option Config.WSConnectionInitTimeout webSocketConnectionInitTimeoutOption = 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._helpMessage = "Control websocket connection_init timeout (default 3 seconds)" } diff --git a/server/src-lib/Hasura/Server/Init/Config.hs b/server/src-lib/Hasura/Server/Init/Config.hs index 8de4653d710..38689479229 100644 --- a/server/src-lib/Hasura/Server/Init/Config.hs +++ b/server/src-lib/Hasura/Server/Init/Config.hs @@ -81,7 +81,6 @@ import Hasura.Incremental (Cacheable) import Hasura.Logging qualified as Logging import Hasura.Prelude 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.Cors qualified as Cors 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 Network.Wai.Handler.Warp qualified as Warp import Network.WebSockets qualified as WebSockets +import Refined (NonNegative, Positive, Refined, unrefine) -------------------------------------------------------------------------------- @@ -285,8 +285,8 @@ data ServeOptionsRaw impl = ServeOptionsRaw rsoLogLevel :: Maybe Logging.LogLevel, rsoDevMode :: Bool, rsoAdminInternalErrors :: Maybe Bool, - rsoEventsHttpPoolSize :: Maybe Numeric.PositiveInt, - rsoEventsFetchInterval :: Maybe (Numeric.NonNegative Milliseconds), + rsoEventsHttpPoolSize :: Maybe (Refined Positive Int), + rsoEventsFetchInterval :: Maybe (Refined NonNegative Milliseconds), rsoAsyncActionsFetchInterval :: Maybe OptionalInterval, rsoEnableRemoteSchemaPermissions :: Schema.Options.RemoteSchemaPermissions, rsoWebSocketCompression :: Bool, @@ -296,8 +296,8 @@ data ServeOptionsRaw impl = ServeOptionsRaw rsoSchemaPollInterval :: Maybe OptionalInterval, -- | See Note '$experimentalFeatures' at bottom of module rsoExperimentalFeatures :: Maybe (HashSet Server.Types.ExperimentalFeature), - rsoEventsFetchBatchSize :: Maybe Numeric.NonNegativeInt, - rsoGracefulShutdownTimeout :: Maybe (Numeric.NonNegative Seconds), + rsoEventsFetchBatchSize :: Maybe (Refined NonNegative Int), + rsoGracefulShutdownTimeout :: Maybe (Refined NonNegative Seconds), rsoWebSocketConnectionInitTimeout :: Maybe WSConnectionInitTimeout, rsoEnableMetadataQueryLoggingEnv :: Server.Logging.MetadataQueryLoggingMode, -- | stores global default naming convention @@ -365,12 +365,12 @@ data OptionalInterval = -- | No polling Skip | -- | Interval time - Interval (Numeric.NonNegative Milliseconds) + Interval (Refined NonNegative Milliseconds) deriving (Show, Eq) -msToOptionalInterval :: Numeric.NonNegative Milliseconds -> OptionalInterval +msToOptionalInterval :: Refined NonNegative Milliseconds -> OptionalInterval msToOptionalInterval = \case - (Numeric.getNonNegative -> 0) -> Skip + (unrefine -> 0) -> Skip s -> Interval s instance FromJSON OptionalInterval where @@ -385,19 +385,19 @@ instance ToJSON OptionalInterval where -- construct a 'ConnParams' data ConnParamsRaw = ConnParamsRaw { -- NOTE: Should any of these types be 'PositiveInt'? - rcpStripes :: Maybe Numeric.NonNegativeInt, - rcpConns :: Maybe Numeric.NonNegativeInt, - rcpIdleTime :: Maybe Numeric.NonNegativeInt, + rcpStripes :: Maybe (Refined NonNegative Int), + rcpConns :: Maybe (Refined NonNegative Int), + rcpIdleTime :: Maybe (Refined NonNegative Int), -- | Time from connection creation after which to destroy a connection and -- choose a different/new one. - rcpConnLifetime :: Maybe (Numeric.NonNegative Time.NominalDiffTime), + rcpConnLifetime :: Maybe (Refined NonNegative Time.NominalDiffTime), rcpAllowPrepare :: Maybe Bool, -- | See @HASURA_GRAPHQL_PG_POOL_TIMEOUT@ - rcpPoolTimeout :: Maybe (Numeric.NonNegative Time.NominalDiffTime) + rcpPoolTimeout :: Maybe (Refined NonNegative Time.NominalDiffTime) } deriving (Show, Eq) -newtype KeepAliveDelay = KeepAliveDelay {unKeepAliveDelay :: Numeric.NonNegative Seconds} +newtype KeepAliveDelay = KeepAliveDelay {unKeepAliveDelay :: Refined NonNegative Seconds} deriving (Eq, Show) instance FromJSON KeepAliveDelay where @@ -412,7 +412,7 @@ instance ToJSON KeepAliveDelay where -------------------------------------------------------------------------------- -- | 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) instance FromJSON WSConnectionInitTimeout where @@ -451,8 +451,8 @@ data ServeOptions impl = ServeOptions soEnabledLogTypes :: HashSet (Logging.EngineLogType impl), soLogLevel :: Logging.LogLevel, soResponseInternalErrorsConfig :: ResponseInternalErrorsConfig, - soEventsHttpPoolSize :: Numeric.PositiveInt, - soEventsFetchInterval :: Numeric.NonNegative Milliseconds, + soEventsHttpPoolSize :: Refined Positive Int, + soEventsFetchInterval :: Refined NonNegative Milliseconds, soAsyncActionsFetchInterval :: OptionalInterval, soEnableRemoteSchemaPermissions :: Schema.Options.RemoteSchemaPermissions, soConnectionOptions :: WebSockets.ConnectionOptions, @@ -462,9 +462,9 @@ data ServeOptions impl = ServeOptions soSchemaPollInterval :: OptionalInterval, -- | See note '$experimentalFeatures' soExperimentalFeatures :: HashSet Server.Types.ExperimentalFeature, - soEventsFetchBatchSize :: Numeric.NonNegativeInt, + soEventsFetchBatchSize :: Refined NonNegative Int, soDevMode :: Bool, - soGracefulShutdownTimeout :: Numeric.NonNegative Seconds, + soGracefulShutdownTimeout :: Refined NonNegative Seconds, soWebSocketConnectionInitTimeout :: WSConnectionInitTimeout, soEventingMode :: Server.Types.EventingMode, -- | See note '$readOnlyMode' diff --git a/server/src-lib/Hasura/Server/Init/Env.hs b/server/src-lib/Hasura/Server/Init/Env.hs index 554edd48899..0b0bf3eee4a 100644 --- a/server/src-lib/Hasura/Server/Init/Env.hs +++ b/server/src-lib/Hasura/Server/Init/Env.hs @@ -36,7 +36,6 @@ import Hasura.GraphQL.Schema.NamingCase qualified as NamingCase import Hasura.GraphQL.Schema.Options qualified as Options import Hasura.Logging qualified as Logging import Hasura.Prelude -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.Server.Auth qualified as Auth import Hasura.Server.Cors qualified as Cors 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.Session qualified as Session 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 fromEnv x = do - i <- fromEnv @(Numeric.NonNegative Milliseconds) x - if Numeric.getNonNegative i == 0 + i <- fromEnv @(Refined NonNegative Milliseconds) x + if unrefine i == 0 then pure $ Config.Skip else pure $ Config.Interval i @@ -280,12 +280,12 @@ instance FromEnv Seconds where instance FromEnv Config.WSConnectionInitTimeout where fromEnv s = do 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 instance FromEnv Config.KeepAliveDelay where fromEnv = - fmap Config.KeepAliveDelay . fromEnv @(Numeric.NonNegative Seconds) + fmap Config.KeepAliveDelay . fromEnv @(Refined NonNegative Seconds) instance FromEnv Auth.JWTConfig where fromEnv = readJson @@ -307,21 +307,17 @@ instance FromEnv Logging.LogLevel where instance FromEnv Template.URLTemplate where 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 = - 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 = - 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 = - fmap (maybeToEither "Only expecting a non negative difftime") Numeric.mkNonNegativeDiffTime =<< (fromEnv @DiffTime s) - -instance FromEnv Numeric.PositiveInt where - fromEnv s = - maybeToEither "Only expecting a positive integer" (Numeric.mkPositiveInt =<< readMaybe s) + maybeToEither "Only expecting a positive integer" (refineFail =<< readMaybe s) instance FromEnv Config.Port where fromEnv s = diff --git a/server/src-lib/Hasura/Server/SchemaUpdate.hs b/server/src-lib/Hasura/Server/SchemaUpdate.hs index 74e99435ae3..9c7c1b6948d 100644 --- a/server/src-lib/Hasura/Server/SchemaUpdate.hs +++ b/server/src-lib/Hasura/Server/SchemaUpdate.hs @@ -27,8 +27,6 @@ import Hasura.Metadata.Class import Hasura.Prelude import Hasura.RQL.DDL.Schema (runCacheRWT) 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.SchemaCache import Hasura.RQL.Types.SchemaCache.Build @@ -44,6 +42,7 @@ import Hasura.Server.SchemaCacheRef import Hasura.Server.Types import Hasura.Session import Network.HTTP.Client qualified as HTTP +import Refined (NonNegative, Refined, unrefine) data ThreadType = TTListener @@ -151,14 +150,14 @@ startSchemaSyncListenerThread :: Logger Hasura -> PG.PGPool -> InstanceId -> - NonNegative Milliseconds -> + Refined NonNegative Milliseconds -> STM.TMVar MetadataResourceVersion -> ManagedT m (Immortal.Thread) startSchemaSyncListenerThread logger pool instanceId interval metaVersionRef = do -- Start listener thread listenerThread <- C.forkManagedT "SchemeUpdate.listener" logger $ - listener logger pool metaVersionRef (Numeric.getNonNegative interval) + listener logger pool metaVersionRef (unrefine interval) logThreadStarted logger instanceId TTListener listenerThread pure listenerThread diff --git a/server/src-test/Data/NumericSpec.hs b/server/src-test/Data/NumericSpec.hs deleted file mode 100644 index 0cc70c126a8..00000000000 --- a/server/src-test/Data/NumericSpec.hs +++ /dev/null @@ -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 diff --git a/server/src-test/Hasura/Server/Init/ArgSpec.hs b/server/src-test/Hasura/Server/Init/ArgSpec.hs index 4a7542afddd..25c2c6296d2 100644 --- a/server/src-test/Hasura/Server/Init/ArgSpec.hs +++ b/server/src-test/Hasura/Server/Init/ArgSpec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + module Hasura.Server.Init.ArgSpec ( spec, ) @@ -7,6 +9,7 @@ where import Control.Lens (preview, _Just) import Data.HashSet qualified as Set +import Data.Time (NominalDiffTime) import Data.URL.Template qualified as Template import Database.PG.Query qualified as PG 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.Logging qualified as Logging import Hasura.Prelude -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.Server.Auth qualified as Auth import Hasura.Server.Cors qualified as Cors 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.Session qualified as Session import Options.Applicative qualified as Opt +import Refined (NonNegative, Positive, refineTH) import Test.Hspec qualified as Hspec {-# ANN module ("HLint: ignore Redundant ==" :: String) #-} @@ -419,12 +422,12 @@ serveParserSpec = Opt.Success rawConnParams -> rawConnParams == UUT.ConnParamsRaw - { rcpStripes = Just $ Numeric.unsafeNonNegativeInt 3, - rcpConns = Just $ Numeric.unsafeNonNegativeInt 2, - rcpIdleTime = Just $ Numeric.unsafeNonNegativeInt 40, - rcpConnLifetime = Just $ Numeric.unsafeNonNegative 400, + { rcpStripes = Just $$(refineTH @NonNegative @Int 3), + rcpConns = Just $$(refineTH @NonNegative @Int 2), + rcpIdleTime = Just $$(refineTH @NonNegative @Int 40), + rcpConnLifetime = Just $$(refineTH @NonNegative @NominalDiffTime 400), rcpAllowPrepare = Just True, - rcpPoolTimeout = Just (Numeric.unsafeNonNegative 45) + rcpPoolTimeout = Just $$(refineTH @NonNegative @NominalDiffTime 45) } Opt.Failure _pf -> False Opt.CompletionInvoked _cr -> False @@ -1402,7 +1405,7 @@ serveParserSpec = result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput 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.CompletionInvoked _cr -> False @@ -1441,7 +1444,7 @@ serveParserSpec = result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput 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.CompletionInvoked _cr -> False @@ -1493,7 +1496,7 @@ serveParserSpec = result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput 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.CompletionInvoked _cr -> False @@ -1597,7 +1600,7 @@ serveParserSpec = result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput 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.CompletionInvoked _cr -> False @@ -1714,7 +1717,7 @@ serveParserSpec = result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput 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.CompletionInvoked _cr -> False @@ -1805,7 +1808,7 @@ serveParserSpec = result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput 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.CompletionInvoked _cr -> False @@ -1844,7 +1847,7 @@ serveParserSpec = result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput 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.CompletionInvoked _cr -> False @@ -1896,7 +1899,7 @@ serveParserSpec = result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput 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.CompletionInvoked _cr -> False diff --git a/server/src-test/Hasura/Server/InitSpec.hs b/server/src-test/Hasura/Server/InitSpec.hs index b66e3758c8e..d73fd0e42c0 100644 --- a/server/src-test/Hasura/Server/InitSpec.hs +++ b/server/src-test/Hasura/Server/InitSpec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + module Hasura.Server.InitSpec ( spec, ) @@ -7,6 +9,7 @@ where import Data.HashSet qualified as Set import Data.Monoid (All (..)) +import Data.Time (NominalDiffTime) import Database.PG.Query qualified as Query import Hasura.GraphQL.Execute.Subscription.Options qualified as Subscription.Options 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 qualified as Logging import Hasura.Prelude -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.SQL.Types qualified as MonadTx import Hasura.Server.Auth qualified as Auth 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.Session qualified as UUT import Network.WebSockets qualified as WS +import Refined (NonNegative, Positive, refineTH, unrefine) import Test.Hspec qualified as Hspec {-# ANN module ("HLint: ignore Redundant ==" :: String) #-} @@ -166,11 +169,11 @@ mkServeOptionsSpec = fmap UUT.soConnParams result `Hspec.shouldBe` Right ( Query.ConnParams - { Query.cpStripes = Numeric.getNonNegativeInt $ UUT._default UUT.pgStripesOption, - Query.cpConns = Numeric.getNonNegativeInt $ UUT._default UUT.pgConnsOption, - Query.cpIdleTime = Numeric.getNonNegativeInt $ UUT._default UUT.pgTimeoutOption, + { Query.cpStripes = unrefine $ UUT._default UUT.pgStripesOption, + Query.cpConns = unrefine $ UUT._default UUT.pgConnsOption, + Query.cpIdleTime = unrefine $ UUT._default UUT.pgTimeoutOption, 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.cpCancel = True } @@ -210,12 +213,12 @@ mkServeOptionsSpec = emptyServeOptionsRaw { UUT.rsoConnParams = UUT.ConnParamsRaw - { rcpStripes = Just (Numeric.unsafeNonNegativeInt 2), - rcpConns = Just (Numeric.unsafeNonNegativeInt 3), - rcpIdleTime = Just (Numeric.unsafeNonNegativeInt 4), - rcpConnLifetime = Just (Numeric.unsafeNonNegative 5), + { rcpStripes = Just $$(refineTH @NonNegative @Int 2), + rcpConns = Just $$(refineTH @NonNegative @Int 3), + rcpIdleTime = Just $$(refineTH @NonNegative @Int 4), + rcpConnLifetime = Just $$(refineTH @NonNegative @NominalDiffTime 5), rcpAllowPrepare = Just True, - rcpPoolTimeout = Just (Numeric.unsafeNonNegative 6) + rcpPoolTimeout = Just $$(refineTH @NonNegative @NominalDiffTime 6) } } -- When @@ -656,8 +659,8 @@ mkServeOptionsSpec = fmap UUT.soLiveQueryOpts result `Hspec.shouldBe` Right ( Subscription.Options.SubscriptionsOptions - { _lqoRefetchInterval = Subscription.Options.RefetchInterval 2, - _lqoBatchSize = Subscription.Options.BatchSize (Numeric.unsafeNonNegativeInt 200) + { _lqoRefetchInterval = Subscription.Options.RefetchInterval $$(refineTH 2), + _lqoBatchSize = Subscription.Options.BatchSize $$(refineTH 200) } ) @@ -679,8 +682,8 @@ mkServeOptionsSpec = fmap UUT.soLiveQueryOpts result `Hspec.shouldBe` Right ( Subscription.Options.SubscriptionsOptions - { _lqoRefetchInterval = Subscription.Options.RefetchInterval 3, - _lqoBatchSize = Subscription.Options.BatchSize (Numeric.unsafeNonNegativeInt 300) + { _lqoRefetchInterval = Subscription.Options.RefetchInterval $$(refineTH 3), + _lqoBatchSize = Subscription.Options.BatchSize $$(refineTH 300) } ) @@ -715,8 +718,8 @@ mkServeOptionsSpec = fmap UUT.soStreamingQueryOpts result `Hspec.shouldBe` Right ( Subscription.Options.SubscriptionsOptions - { _lqoRefetchInterval = Subscription.Options.RefetchInterval 2, - _lqoBatchSize = Subscription.Options.BatchSize (Numeric.unsafeNonNegativeInt 200) + { _lqoRefetchInterval = Subscription.Options.RefetchInterval $$(refineTH 2), + _lqoBatchSize = Subscription.Options.BatchSize $$(refineTH 200) } ) @@ -738,8 +741,8 @@ mkServeOptionsSpec = fmap UUT.soStreamingQueryOpts result `Hspec.shouldBe` Right ( Subscription.Options.SubscriptionsOptions - { _lqoRefetchInterval = Subscription.Options.RefetchInterval 3, - _lqoBatchSize = Subscription.Options.BatchSize (Numeric.unsafeNonNegativeInt 300) + { _lqoRefetchInterval = Subscription.Options.RefetchInterval $$(refineTH 3), + _lqoBatchSize = Subscription.Options.BatchSize $$(refineTH 300) } ) @@ -923,17 +926,17 @@ mkServeOptionsSpec = -- Then 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 let -- Given - rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsHttpPoolSize = Just (Numeric.unsafePositiveInt 300)} + rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsHttpPoolSize = Just $$(refineTH @Positive @Int 300)} -- When env = [(UUT._envVar UUT.graphqlEventsHttpPoolSizeOption, "200")] -- Then 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.it "Default == 1" $ do @@ -954,17 +957,17 @@ mkServeOptionsSpec = -- Then 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 let -- Given - rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsFetchInterval = Just $ Numeric.unsafeNonNegative 300} + rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsFetchInterval = Just $$(refineTH @NonNegative @Milliseconds 300)} -- When env = [(UUT._envVar UUT.graphqlEventsFetchIntervalOption, "200")] -- Then 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.it "Default == 1000" $ do @@ -985,7 +988,7 @@ mkServeOptionsSpec = -- Then 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 let -- Given @@ -999,13 +1002,13 @@ mkServeOptionsSpec = Hspec.it "Arg > Env" $ do let -- Given - rawServeOptions = emptyServeOptionsRaw {UUT.rsoAsyncActionsFetchInterval = Just (UUT.Interval $ Numeric.unsafeNonNegative 300)} + rawServeOptions = emptyServeOptionsRaw {UUT.rsoAsyncActionsFetchInterval = Just (UUT.Interval $$(refineTH 300))} -- When env = [(UUT._envVar UUT.asyncActionsFetchIntervalOption, "200")] -- Then 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.it "Default == False" $ do @@ -1090,17 +1093,17 @@ mkServeOptionsSpec = -- Then 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 let -- Given - rawServeOptions = emptyServeOptionsRaw {UUT.rsoWebSocketKeepAlive = Just (UUT.KeepAliveDelay $ Numeric.unsafeNonNegative 20)} + rawServeOptions = emptyServeOptionsRaw {UUT.rsoWebSocketKeepAlive = Just (UUT.KeepAliveDelay $$(refineTH 20))} -- When env = [(UUT._envVar UUT.webSocketKeepAliveOption, "10")] -- Then 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.it "Default == FunctionPermissionsInferred" $ do @@ -1183,7 +1186,7 @@ mkServeOptionsSpec = -- Then 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 let -- Given @@ -1197,13 +1200,13 @@ mkServeOptionsSpec = Hspec.it "Arg > Env" $ do let -- Given - rawServeOptions = emptyServeOptionsRaw {UUT.rsoSchemaPollInterval = Just (UUT.Interval $ Numeric.unsafeNonNegative 3000)} + rawServeOptions = emptyServeOptionsRaw {UUT.rsoSchemaPollInterval = Just (UUT.Interval $$(refineTH 3000))} -- When env = [(UUT._envVar UUT.schemaPollIntervalOption, "2000")] -- Then 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.it "Default == mempty" $ do @@ -1249,17 +1252,17 @@ mkServeOptionsSpec = -- Then 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 let -- Given - rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsFetchBatchSize = Just (Numeric.unsafeNonNegativeInt 300)} + rawServeOptions = emptyServeOptionsRaw {UUT.rsoEventsFetchBatchSize = Just $$(refineTH @NonNegative @Int 300)} -- When env = [(UUT._envVar UUT.eventsFetchBatchSizeOption, "200")] -- Then 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.it "Default == 60" $ do @@ -1282,17 +1285,17 @@ mkServeOptionsSpec = -- Then 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 let -- Given - rawServeOptions = emptyServeOptionsRaw {UUT.rsoGracefulShutdownTimeout = Just (Numeric.unsafeNonNegative 300)} + rawServeOptions = emptyServeOptionsRaw {UUT.rsoGracefulShutdownTimeout = Just $$(refineTH @NonNegative @Seconds 300)} -- When env = [(UUT._envVar UUT.gracefulShutdownOption, "200")] -- Then 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.it "Default == 3" $ do @@ -1313,20 +1316,20 @@ mkServeOptionsSpec = -- Then 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 let -- Given rawServeOptions = emptyServeOptionsRaw - { UUT.rsoWebSocketConnectionInitTimeout = Just (UUT.WSConnectionInitTimeout (Numeric.unsafeNonNegative 300)) + { UUT.rsoWebSocketConnectionInitTimeout = Just (UUT.WSConnectionInitTimeout $$(refineTH @NonNegative @Seconds 300)) } -- When env = [(UUT._envVar UUT.webSocketConnectionInitTimeoutOption, "200")] -- Then 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.it "Default == MetadataQueryLoggingDisabled" $ do diff --git a/server/tests-hspec/Harness/Constants.hs b/server/tests-hspec/Harness/Constants.hs index ea3406b8fc6..5eb371cfadb 100644 --- a/server/tests-hspec/Harness/Constants.hs +++ b/server/tests-hspec/Harness/Constants.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE TemplateHaskell #-} -- | Constant configurations used throughout the test suite. 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.Logging qualified as L import Hasura.Prelude -import Hasura.RQL.Types.Numeric qualified as Numeric import Hasura.Server.Cors (CorsConfig (CCAllowAll)) import Hasura.Server.Init ( API (CONFIG, DEVELOPER, GRAPHQL, METADATA), @@ -65,6 +65,7 @@ import Hasura.Server.Types ReadOnlyMode (ReadOnlyModeDisabled), ) import Network.WebSockets qualified as WS +import Refined (refineTH) ------------------------------------------------------------------------------- @@ -268,11 +269,11 @@ serveOptions = soInferFunctionPermissions = Options.InferFunctionPermissions, soEnableMaintenanceMode = MaintenanceModeDisabled, -- MUST be disabled to be able to modify schema. - soSchemaPollInterval = Interval (Numeric.unsafeNonNegative 10), + soSchemaPollInterval = Interval $$(refineTH 10), soExperimentalFeatures = Set.singleton EFStreamingSubscriptions, - soEventsFetchBatchSize = Numeric.unsafeNonNegativeInt 1, + soEventsFetchBatchSize = $$(refineTH 1), soDevMode = True, - soGracefulShutdownTimeout = Numeric.unsafeNonNegative 0, -- Don't wait to shutdown. + soGracefulShutdownTimeout = $$(refineTH 0), -- Don't wait to shutdown. soWebSocketConnectionInitTimeout = Init._default Init.webSocketConnectionInitTimeoutOption, soEventingMode = EventingEnabled, soReadOnlyMode = ReadOnlyModeDisabled,