Replace Hasura.RQL.Types.Numeric with refined

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5913
GitOrigin-RevId: 96e218229a08dfbc5a598d709be1ee2083d41ec6

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,

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

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)
                 )
             )
 

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
 

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

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

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

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
 

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
 

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

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 $

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

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}
 

server/src-lib/Hasura/RQL/Types/Numeric.hs

@@ -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"

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

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 {..}

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)"
     }

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'

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 =

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
 

server/src-test/Data/NumericSpec.hs

@@ -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

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
 

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

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,