diff --git a/.ghcversion b/.ghcversion index 3a535e608d923..c261e8cf8e8a0 100644 --- a/.ghcversion +++ b/.ghcversion @@ -1 +1 @@ -9.4.5 +9.6.4 diff --git a/cabal.project b/cabal.project index 35abd1d32bc32..bac81a3852b95 100644 --- a/cabal.project +++ b/cabal.project @@ -16,15 +16,7 @@ -- -- See: https://www.haskell.org/cabal/users-guide/nix-local-build.html#configuring-builds-with-cabal-project -with-compiler: ghc-9.4.5 --- Work around bugs not yet fixed in 9.4.5. These are only enabled with O2 --- which we don't currently use, but disable these defensively --- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10282 -package * - ghc-options: - -fno-dicts-strict - -fno-spec-constr - +with-compiler: ghc-9.6.4 -- package-level parallelism: jobs: $ncpus @@ -34,6 +26,7 @@ packages: server/lib/*/*.cabal packages: server/forks/*/*.cabal -- TODO remove these when we are able: +allow-newer: req:template-haskell allow-newer: ekg-core:base allow-newer: ekg-core:ghc-prim allow-newer: ekg-core:inspection-testing @@ -45,14 +38,55 @@ allow-newer: ekg-prometheus:text allow-newer: ekg-prometheus:bytestring -- Migrating to 0.25+ looks like it will be a real pain... :( -- https://github.com/morpheusgraphql/morpheus-graphql/pull/766 +allow-newer: relude:base +allow-newer: relude:ghc-prim allow-newer: morpheus-graphql:text +allow-newer: morpheus-graphql:relude +allow-newer: morpheus-graphql:vector +allow-newer: morpheus-graphql:transformers allow-newer: morpheus-graphql-app:text +allow-newer: morpheus-graphql-app:vector +allow-newer: morpheus-graphql-app:transformers allow-newer: morpheus-graphql-code-gen:text +allow-newer: morpheus-graphql-code-gen:optparse-applicative allow-newer: morpheus-graphql-code-gen-utils:text allow-newer: morpheus-graphql-core:text +allow-newer: morpheus-graphql-core:transformers +allow-newer: morpheus-graphql-core:vector allow-newer: morpheus-graphql-server:text +allow-newer: morpheus-graphql-server:transformers +allow-newer: morpheus-graphql-server:vector allow-newer: morpheus-graphql-client:text +allow-newer: morpheus-graphql-client:req +allow-newer: morpheus-graphql-client:transformers +allow-newer: morpheus-graphql-client:vector allow-newer: morpheus-graphql-subscriptions:text +allow-newer: morpheus-graphql-subscriptions:transformers +allow-newer: servant-openapi3:base +allow-newer: openapi3:base +allow-newer: servant-client:base +allow-newer: servant-client:transformers +allow-newer: servant-client:mtl +allow-newer: servant-client-core:base +allow-newer: servant-client-core:free +allow-newer: servant-client-core:template-haskell +allow-newer: servant-client-core:transformers +allow-newer: servant-server:base +allow-newer: servant-server:template-haskell +allow-newer: servant-server:transformers +allow-newer: servant-server:mtl +allow-newer: servant:base +allow-newer: servant:mtl +allow-newer: ghc-heap-view:base +allow-newer: ghc-heap-view:Cabal +allow-newer: servant:transformers +allow-newer: singleton-bool:base +allow-newer: semigroupoids:base +allow-newer: http-api-data:base +allow-newer: validation:assoc +allow-newer: aeson:th-abstraction +allow-newer: optics-th:th-abstraction +allow-newer: generics-sop:th-abstraction -- https://gitlab.haskell.org/ghc/ghc-debug/-/merge_requests/27 allow-newer: ghc-debug-stub:ghc-prim @@ -67,7 +101,7 @@ package * -- For tooling support, e.g. HLS: ghc-options: -fwrite-ide-info - -- we statically link malloc from mimalloc. Out of an abundance of caution, + -- we statically link malloc from mimalloc. Out of an abundance of caution, -- disable special treatment of these in all the foreign code we build. The -- only risk is potential for some missed optimizations. -- See: https://github.com/microsoft/mimalloc/issues/785 @@ -95,6 +129,25 @@ package graphql-engine allow-newer: hedgehog-generic:base allow-newer: hedgehog-generic:hedgehog +-- 9.6 support. Awaiting release I guess... +source-repository-package + type: git + location: https://github.com/agrafix/Spock + tag: 40d028bfea0e94ca7096c719cd024ca47a46e559 + subdir: Spock-core + +-- 9.6 support: https://github.com/jfischoff/postgres-options/pull/7 +source-repository-package + type: git + location: https://github.com/jfischoff/postgres-options.git + tag: 3100f7ca4319748a07a46e2838f4c80f8e3f076a + +-- 9.6 support: https://github.com/MichaelXavier/cron/pull/51 +source-repository-package + type: git + location: https://github.com/TristanCacqueray/cron.git + tag: 5f5b662a1d7abc3951ea5a2a625bbf3e83f7a11a + source-repository-package type: git location: https://github.com/hasura/kriti-lang.git @@ -121,6 +174,7 @@ source-repository-package location: https://github.com/hasura/ekg-core.git tag: df610859603b504494ad770bdbb7053a7f0b9a6c +-- because we need 27d87f01, not yet released source-repository-package type: git location: https://github.com/snoyberg/yaml.git diff --git a/cabal.project.freeze b/cabal.project.freeze index 90619efec3d39..e6278672d8c15 100644 --- a/cabal.project.freeze +++ b/cabal.project.freeze @@ -1,11 +1,11 @@ active-repositories: hackage.haskell.org:merge -constraints: any.Cabal ==3.8.1.0, - any.Cabal-syntax ==3.8.1.0, +constraints: any.Cabal ==3.10.1.0, + any.Cabal-syntax ==3.10.1.0, any.Diff ==0.4.1, any.Glob ==0.10.2, any.HTTP ==4000.4.1, any.HUnit ==1.6.2.0, - any.OneTuple ==0.3.1, + any.OneTuple ==0.4.1.1, any.Only ==0.1, any.QuickCheck ==2.14.2, any.RSA ==2.4.1, @@ -19,15 +19,16 @@ constraints: any.Cabal ==3.8.1.0, any.aeson-optics ==1.2.0.1, any.aeson-pretty ==0.8.9, any.aeson-qq ==0.8.4, - any.alex ==3.2.7.1, - any.ansi-terminal ==0.11.3, - any.ansi-wl-pprint ==0.6.9, + any.alex ==3.3.0.0, + any.ansi-terminal ==0.11.5, + any.ansi-terminal-types ==0.11.5, + any.ansi-wl-pprint ==1.0.2, any.appar ==0.1.8, - any.array ==0.5.4.0, + any.array ==0.5.6.0, any.asn1-encoding ==0.9.6, any.asn1-parse ==0.9.5, any.asn1-types ==0.3.4, - any.assoc ==1.0.2, + any.assoc ==1.1, any.async ==2.2.4, any.atomic-primops ==0.8.4, any.attoparsec ==0.14.4, @@ -36,32 +37,32 @@ constraints: any.Cabal ==3.8.1.0, any.auto-update ==0.1.6, any.autodocodec ==0.2.0.3, any.autodocodec-openapi3 ==0.2.1.1, - any.barbies ==2.0.3.1, - any.base ==4.17.1.0, + any.barbies ==2.0.4.0, + any.base ==4.18.2.0, any.base-compat ==0.12.2, any.base-compat-batteries ==0.12.2, - any.base-orphans ==0.8.7, + any.base-orphans ==0.9.0, any.base-prelude ==1.6.1, any.base16-bytestring ==1.0.2.0, any.base64-bytestring ==1.2.1.0, any.basement ==0.0.15, - any.bifunctors ==5.5.13, + any.bifunctors ==5.6.1, any.bimap ==0.5.0, any.binary ==0.8.9.1, any.binary-orphans ==1.0.4.1, - any.binary-parser ==0.5.7.2, - any.bitvec ==1.1.3.0, + any.binary-parser ==0.5.7.3, + any.bitvec ==1.1.4.0, any.blaze-builder ==0.4.2.2, any.blaze-html ==0.9.1.2, any.blaze-markup ==0.8.2.8, - any.boring ==0.2, - any.brick ==1.5, + any.boring ==0.2.1, + any.brick ==1.9, any.bsb-http-chunked ==0.0.0.4, any.byteable ==0.1.1, any.byteorder ==1.0.4, - any.bytestring ==0.11.4.0, + any.bytestring ==0.11.5.3, any.bytestring-builder ==0.10.8.2.0, - any.bytestring-lexing ==0.5.0.9, + any.bytestring-lexing ==0.5.0.10, any.bytestring-strict-builder ==0.4.5.6, any.bytestring-tree-builder ==0.2.7.10, any.cabal-doctest ==1.0.9, @@ -71,24 +72,24 @@ constraints: any.Cabal ==3.8.1.0, any.cereal ==0.5.8.3, any.charset ==0.3.9, any.clock ==0.8.3, - any.cmdargs ==0.10.21, + any.cmdargs ==0.10.22, any.code-page ==0.2.1, any.colour ==2.3.6, any.comonad ==5.0.8, any.concise ==0.1.0.1, - any.concurrent-output ==1.10.16, - any.conduit ==1.3.4.3, + any.concurrent-output ==1.10.18, + any.conduit ==1.3.5, any.conduit-extra ==1.3.6, any.config-ini ==0.2.5.0, any.connection ==0.3.1, any.constraints ==0.13.4, - any.constraints-extras ==0.3.2.1, + any.constraints-extras ==0.4.0.0, any.containers ==0.6.7, any.contravariant ==1.5.5, any.contravariant-extras ==0.3.5.3, - any.cookie ==0.4.5, - any.criterion ==1.5.13.0, - any.criterion-measurement ==0.1.4.0, + any.cookie ==0.4.6, + any.criterion ==1.6.3.0, + any.criterion-measurement ==0.2.1.0, any.cron ==0.7.0, any.crypto-api ==0.13.3, any.crypto-pubkey-types ==0.4.3, @@ -112,58 +113,58 @@ constraints: any.Cabal ==3.8.1.0, any.data-serializer ==0.3.5, any.data-textual ==0.3.0.3, any.dec ==0.0.5, - any.deepseq ==1.4.8.0, - any.deferred-folds ==0.9.18.2, + any.deepseq ==1.4.8.1, + any.deferred-folds ==0.9.18.3, any.dense-linear-algebra ==0.1.0.0, any.dependent-map ==0.4.0.0, - any.dependent-sum ==0.6.2.0, - any.dependent-sum-template ==0.1.1.1, - any.directory ==1.3.7.1, + any.dependent-sum ==0.7.2.0, + any.dependent-sum-template ==0.2.0.0, + any.directory ==1.3.8.1, any.distributive ==0.6.2.1, any.dlist ==1.0, any.doctest ==0.21.1, any.double-conversion ==2.0.4.2, - any.easy-file ==0.2.2, + any.easy-file ==0.2.5, any.either ==5.0.2, any.ekg-core ==0.1.1.7, any.entropy ==0.4.1.10, any.erf ==2.0.0.0, any.errors ==2.3.0, - any.exceptions ==0.10.5, + any.exceptions ==0.10.7, any.extensible-exceptions ==0.1.1.4, - any.extra ==1.7.12, + any.extra ==1.7.13, any.fail ==4.9.0.0, - any.fast-logger ==3.1.2, + any.fast-logger ==3.2.1, any.file-embed ==0.0.15.0, - any.filepath ==1.4.2.2, + any.filepath ==1.4.200.1, any.flush-queue ==1.0.0, - any.focus ==1.0.3, + any.focus ==1.0.3.1, any.fold-debounce ==0.2.0.11, - any.foldl ==1.4.12, + any.foldl ==1.4.14, any.formatting ==7.2.0, - any.free ==5.1.9, - any.generic-lens ==2.2.1.0, + any.free ==5.2, + any.generic-lens ==2.2.2.0, any.generic-lens-core ==2.2.1.0, any.generic-monoid ==0.1.0.1, - any.generically ==0.1, - any.generics-sop ==0.5.1.2, - any.ghc ==9.4.5, + any.generically ==0.1.1, + any.generics-sop ==0.5.1.3, + any.ghc ==9.6.4, any.ghc-bignum ==1.3, - any.ghc-boot ==9.4.5, - any.ghc-boot-th ==9.4.5, + any.ghc-boot ==9.6.4, + any.ghc-boot-th ==9.6.4, any.ghc-debug-convention ==0.4.0.0, any.ghc-debug-stub ==0.4.0.0, - any.ghc-heap ==9.4.5, + any.ghc-heap ==9.6.4, any.ghc-heap-view ==0.6.4, any.ghc-paths ==0.1.0.12, - any.ghc-prim ==0.9.0, - any.ghci ==9.4.5, - any.happy ==1.20.0, - any.hashable ==1.4.1.0, + any.ghc-prim ==0.10.0, + any.ghci ==9.6.4, + any.happy ==1.20.1.1, + any.hashable ==1.4.2.0, any.hashtables ==1.3.1, - any.haskell-lexer ==1.1, + any.haskell-lexer ==1.1.1, any.haskell-src-exts ==1.23.1, - any.haskell-src-meta ==0.8.11, + any.haskell-src-meta ==0.8.12, any.hasql ==1.5.0.5, any.hasql-pool ==0.5.2.2, any.hasql-transaction ==1.0.1.1, @@ -171,13 +172,13 @@ constraints: any.Cabal ==3.8.1.0, any.hedgehog-generic ==0.1, any.hostname ==1.0, any.hourglass ==0.2.12, - any.hpc ==0.6.1.0, + any.hpc ==0.6.2.0, any.hs-opentelemetry-otlp ==0.0.1.0, - any.hsc2hs ==0.68.8, - any.hspec ==2.10.10, - any.hspec-core ==2.10.10, - any.hspec-discover ==2.10.10, - any.hspec-expectations ==0.8.2, + any.hsc2hs ==0.68.9, + any.hspec ==2.11.1, + any.hspec-core ==2.11.1, + any.hspec-discover ==2.11.1, + any.hspec-expectations ==0.8.3, any.hspec-expectations-json ==1.0.0.7, any.hspec-expectations-lifted ==0.10.0, any.hspec-hedgehog ==0.0.1.2, @@ -189,57 +190,57 @@ constraints: any.Cabal ==3.8.1.0, any.http-date ==0.0.11, any.http-media ==0.8.0.0, any.http-types ==0.12.3, - any.http2 ==3.0.3, + any.http2 ==4.1.2, any.hvect ==0.4.0.1, any.immortal ==0.2.2.1, any.indexed-profunctors ==0.1.1, - any.indexed-traversable ==0.1.2, - any.indexed-traversable-instances ==0.1.1.1, - any.insert-ordered-containers ==0.2.5.1, + any.indexed-traversable ==0.1.2.1, + any.indexed-traversable-instances ==0.1.1.2, + any.insert-ordered-containers ==0.2.5.2, any.inspection-testing ==0.5.0.1, any.integer-gmp ==1.1, any.integer-logarithms ==1.0.3.1, - any.invariant ==0.6.1, + any.invariant ==0.6.2, any.iproute ==1.7.12, any.iso8601-time ==0.1.5, - any.isomorphism-class ==0.1.0.7, - any.jose ==0.9, - any.jose-jwt ==0.9.4, + any.isomorphism-class ==0.1.0.9, + any.jose ==0.10, + any.jose-jwt ==0.9.5, any.js-chart ==2.9.4.1, any.jwt ==0.11.0, any.kan-extensions ==5.2.5, any.keys ==3.12.3, any.kriti-lang ==0.3.3, any.launchdarkly-server-sdk ==4.0.0, - any.lens ==5.2.2, + any.lens ==5.2.3, any.lens-aeson ==1.2.2, any.lens-family ==2.1.2, any.lens-family-core ==2.1.2, any.libdeflate-hs ==0.1.0.0, any.libyaml ==0.1.2, - any.lifted-async ==0.10.2.3, + any.lifted-async ==0.10.2.4, any.lifted-base ==0.2.3.12, - any.list-t ==1.0.5.3, - any.logict ==0.8.0.0, + any.list-t ==1.0.5.6, + any.logict ==0.8.1.0, any.lrucache ==1.2.0.1, any.lucid2 ==0.0.20221012, - any.managed ==1.0.9, - any.markdown-unlit ==0.5.1, + any.managed ==1.0.10, + any.markdown-unlit ==0.6.0, any.math-functions ==0.3.4.2, - any.megaparsec ==9.2.2, + any.megaparsec ==9.3.1, any.memory ==0.18.0, - any.microlens ==0.4.13.0, - any.microlens-mtl ==0.2.0.2, - any.microlens-th ==0.4.3.10, + any.microlens ==0.4.13.1, + any.microlens-mtl ==0.2.0.3, + any.microlens-th ==0.4.3.14, any.microstache ==1.0.2.3, any.mime-types ==0.1.1.0, any.mmorph ==1.2.0, any.modern-uri ==0.3.6.0, any.monad-control ==1.0.3.1, - any.monad-logger ==0.3.37, + any.monad-logger ==0.3.39, any.monad-loops ==0.4.3, any.monad-time ==0.4.0.0, - any.monad-validate ==1.2.0.1, + any.monad-validate ==1.3.0.0, any.mono-traversable ==1.0.15.3, any.morpheus-graphql ==0.24.3, any.morpheus-graphql-app ==0.24.3, @@ -249,30 +250,30 @@ constraints: any.Cabal ==3.8.1.0, any.morpheus-graphql-core ==0.24.3, any.morpheus-graphql-server ==0.24.3, any.morpheus-graphql-subscriptions ==0.24.3, - any.mtl ==2.2.2, + any.mtl ==2.3.1, any.mtl-compat ==0.2.2, - any.mustache ==2.4.1, + any.mustache ==2.4.2, any.mwc-random ==0.15.0.2, any.natural-transformation ==0.4, - any.network ==3.1.2.7, + any.network ==3.1.4.0, any.network-bsd ==2.8.1.0, any.network-byte-order ==0.1.6, any.network-info ==0.2.1, any.network-ip ==0.3.0.3, - any.network-uri ==2.6.4.1, + any.network-uri ==2.6.4.2, any.nonempty-containers ==0.3.4.4, - any.nonempty-vector ==0.2.1.0, + any.nonempty-vector ==0.2.2.0, any.odbc ==0.2.7, any.old-locale ==1.0.0.7, any.old-time ==1.1.0.3, - any.openapi3 ==3.2.2, + any.openapi3 ==3.2.3, any.optics-core ==0.4.1, any.optics-extra ==0.4.2.1, any.optics-th ==0.4.1, - any.optparse-applicative ==0.16.1.0, - any.optparse-generic ==1.4.8, + any.optparse-applicative ==0.18.1.0, + any.optparse-generic ==1.5.1, any.parallel ==3.2.2.0, - any.parsec ==3.1.15.1, + any.parsec ==3.1.16.1, any.parser-combinators ==1.3.0, any.parsers ==0.12.11, any.pcre-light ==0.4.1.0, @@ -280,56 +281,56 @@ constraints: any.Cabal ==3.8.1.0, any.pointed ==5.0.4, any.postgres-options ==0.2.0.0, any.postgresql-binary ==0.12.5, - any.postgresql-libpq ==0.9.4.3, + any.postgresql-libpq ==0.9.5.0, any.postgresql-simple ==0.6.5, any.pretty ==1.1.3.6, any.pretty-show ==1.10, any.pretty-simple ==4.1.2.0, any.prettyprinter ==1.7.1, any.prettyprinter-ansi-terminal ==1.1.3, + any.prettyprinter-compat-ansi-wl-pprint ==1.0.2, any.primitive ==0.7.4.0, - any.primitive-extras ==0.10.1.5, + any.primitive-extras ==0.10.1.6, any.primitive-unlifted ==0.1.3.1, - any.process ==1.6.16.0, + any.process ==1.6.17.0, any.profunctors ==5.6.2, - any.proto-lens ==0.7.1.2, - any.proto-lens-runtime ==0.7.0.3, + any.proto-lens ==0.7.1.3, + any.proto-lens-runtime ==0.7.0.4, any.psqueues ==0.2.7.3, - any.quickcheck-instances ==0.3.28, + any.quickcheck-instances ==0.3.29.1, any.quickcheck-io ==0.2.0, any.random ==1.2.1.1, any.raw-strings-qq ==1.1, - any.recv ==0.0.0, - any.refined ==0.8, - any.reflection ==2.1.6, + any.recv ==0.1.0, + any.refined ==0.8.1, + any.reflection ==2.1.7, any.regex-base ==0.94.0.2, any.regex-posix ==0.96.0.1, - any.regex-tdfa ==1.3.2, + any.regex-tdfa ==1.3.2.1, any.relude ==1.2.0.0, any.req ==3.13.0, any.reroute ==0.7.0.0, any.resourcet ==1.2.6, - any.retry ==0.9.3.0, + any.retry ==0.9.3.1, any.rts ==1.0.2, any.safe ==0.3.19, any.safe-exceptions ==0.1.7.3, - any.sandwich ==0.1.3.0, + any.sandwich ==0.1.5.1, any.scanner ==0.3.1, any.scientific ==0.3.7.0, - any.semialign ==1.2.0.1, + any.semialign ==1.3, any.semigroupoids ==5.3.7, any.semigroups ==0.20, any.semver ==0.4.0.1, - any.servant ==0.19.1, - any.servant-client ==0.19, - any.servant-client-core ==0.19, - any.servant-openapi3 ==2.0.1.5, - any.servant-server ==0.19.2, - any.setenv ==0.1.1.3, - any.shakespeare ==2.0.30, - any.simple-sendfile ==0.2.30, + any.servant ==0.20, + any.servant-client ==0.20, + any.servant-client-core ==0.20, + any.servant-openapi3 ==2.0.1.6, + any.servant-server ==0.20, + any.shakespeare ==2.1.0, + any.simple-sendfile ==0.2.31, any.singleton-bool ==0.1.6, - any.smallcheck ==1.2.1, + any.smallcheck ==1.2.1.1, any.socks ==0.6.1, any.some ==1.0.5, any.sop-core ==0.5.0.2, @@ -337,66 +338,63 @@ constraints: any.Cabal ==3.8.1.0, any.splitmix ==0.1.0.4, any.statistics ==0.16.2.0, any.stm ==2.5.1.0, - any.stm-chans ==3.0.0.6, - any.stm-containers ==1.2, + any.stm-chans ==3.0.0.9, + any.stm-containers ==1.2.0.2, any.stm-delay ==0.1.1.1, - any.stm-hamt ==1.2.0.8, - any.streaming-commons ==0.2.2.5, - any.strict ==0.4.0.1, + any.stm-hamt ==1.2.0.11, + any.streaming-commons ==0.2.2.6, + any.strict ==0.5, any.string-conversions ==0.4.0.1, - any.string-interpolate ==0.3.2.0, + any.string-interpolate ==0.3.2.1, any.superbuffer ==0.3.1.2, - any.syb ==0.7.2.2, + any.syb ==0.7.2.3, any.system-cxx-std-lib ==1.0, - any.system-filepath ==0.4.14, - any.tagged ==0.8.6.1, - any.tasty ==1.4.2.3, - any.tasty-bench ==0.3.2, - any.template-haskell ==2.19.0.0, - any.template-haskell-compat-v0208 ==0.1.9.1, + any.tagged ==0.8.7, + any.tasty ==1.4.3, + any.tasty-bench ==0.3.4, + any.template-haskell ==2.20.0.0, + any.template-haskell-compat-v0208 ==0.1.9.2, any.temporary ==1.3, - any.terminal-size ==0.3.3, - any.terminfo ==0.4.1.5, + any.terminal-size ==0.3.4, + any.terminfo ==0.4.1.6, any.test-framework ==0.8.2.0, any.test-framework-hunit ==0.3.0.2, any.testcontainers ==0.5.0.0, - any.text ==2.0.1, + any.text ==2.0.2, any.text-builder ==0.6.7, - any.text-builder-dev ==0.3.3, + any.text-builder-dev ==0.3.3.2, any.text-conversions ==0.3.1.1, any.text-latin1 ==0.3.1, any.text-printer ==0.5.0.2, any.text-short ==0.1.5, - any.text-zipper ==0.12, + any.text-zipper ==0.13, any.tf-random ==0.5, - any.th-abstraction ==0.4.5.0, + any.th-abstraction ==0.6.0.0, any.th-compat ==0.1.4, - any.th-expand-syns ==0.4.10.0, - any.th-extras ==0.0.0.6, - any.th-lift ==0.8.2, + any.th-expand-syns ==0.4.11.0, + any.th-lift ==0.8.4, any.th-lift-instances ==0.1.20, any.th-orphans ==0.13.14, any.th-reify-many ==0.1.10, - any.these ==1.1.1.1, + any.these ==1.2, any.these-skinny ==0.7.5, any.time ==1.12.2, any.time-compat ==1.9.6.1, any.time-locale-compat ==0.1.1.5, any.time-manager ==0.0.0, any.tls ==1.6.0, - any.transformers ==0.5.6.2, + any.transformers ==0.6.1.0, any.transformers-base ==0.4.6, any.transformers-compat ==0.7.2, any.type-equality ==1, any.type-hint ==0.1, - any.typed-process ==0.2.10.1, + any.typed-process ==0.2.11.0, any.unagi-chan ==0.4.1.4, - any.unbounded-delays ==0.1.1.1, - any.unix ==2.7.3, - any.unix-compat ==0.6, - any.unix-time ==0.4.8, - any.unliftio ==0.2.23.0, - any.unliftio-core ==0.2.0.1, + any.unix ==2.8.4.0, + any.unix-compat ==0.7, + any.unix-time ==0.4.9, + any.unliftio ==0.2.24.0, + any.unliftio-core ==0.2.1.0, any.unordered-containers ==0.2.19.1, any.uri-bytestring ==0.3.3.1, any.uri-encode ==1.5.0.7, @@ -411,19 +409,18 @@ constraints: any.Cabal ==3.8.1.0, any.vector ==0.12.3.1, any.vector-algorithms ==0.9.0.1, any.vector-binary-instances ==0.2.5.2, - any.vector-instances ==3.4, + any.vector-instances ==3.4.2, any.vector-th-unbox ==0.2.2, any.void ==0.7.3, - any.vty ==5.37, + any.vty ==5.38, any.wai ==3.2.3, any.wai-app-static ==3.1.7.4, any.wai-extra ==3.1.13.0, any.wai-logger ==2.4.0, - any.warp ==3.3.23, - any.wcwidth ==0.0.2, + any.warp ==3.3.25, any.websockets ==0.12.7.3, any.wide-word ==0.1.5.0, - any.witch ==1.1.2.0, + any.witch ==1.2.0.2, any.witherable ==0.4.2, any.wl-pprint-annotated ==0.1.0.1, any.word-wrap ==0.5, @@ -440,4 +437,4 @@ constraints: any.Cabal ==3.8.1.0, any.xml-types ==0.3.8, any.yaml ==0.11.10.0, any.zlib ==0.6.3.0, -index-state: hackage.haskell.org 2023-04-26T15:43:24Z +index-state: hackage.haskell.org 2023-09-27T18:59:39Z diff --git a/cabal/dev-sh-prof-heap-infomap.project.local b/cabal/dev-sh-prof-heap-infomap.project.local index f605b30bfcca1..d49b38fd523e6 100644 --- a/cabal/dev-sh-prof-heap-infomap.project.local +++ b/cabal/dev-sh-prof-heap-infomap.project.local @@ -30,6 +30,10 @@ package graphql-engine-pro -- TODO would be nice to refactor other dev-sh.project.local to use program-options' as well (and force cabal 3.8) program-options ghc-options: -fdistinct-constructor-tables -finfo-table-map + -- TODO: consider using this combination instead, which we might use eventually in + -- production (although this is still not sufficient to get the file size down + -- small enough imo): + -- ghc-options: -fdistinct-constructor-tables -finfo-table-map -fno-info-table-map-with-stack -fno-info-table-map-with-fallback -- For each module, STG will be dumped to: -- dist-newstyle/**/*.dump-stg-final ghc-options: -ddump-stg-final -ddump-to-file diff --git a/dc-agents/dc-api-types/package.json b/dc-agents/dc-api-types/package.json index f03c7f1871d5d..59622513290be 100644 --- a/dc-agents/dc-api-types/package.json +++ b/dc-agents/dc-api-types/package.json @@ -1,6 +1,6 @@ { "name": "@hasura/dc-api-types", - "version": "0.43.0", + "version": "0.44.0", "description": "Hasura GraphQL Engine Data Connector Agent API types", "author": "Hasura (https://github.com/hasura/graphql-engine)", "license": "Apache-2.0", diff --git a/dc-agents/dc-api-types/src/agent.openapi.json b/dc-agents/dc-api-types/src/agent.openapi.json index 88cb24f11018b..917cd30f175d6 100644 --- a/dc-agents/dc-api-types/src/agent.openapi.json +++ b/dc-agents/dc-api-types/src/agent.openapi.json @@ -1,5 +1,4 @@ { - "openapi": "3.0.0", "info": { "title": "", "version": "" @@ -3628,5 +3627,6 @@ "type": "object" } } - } + }, + "openapi": "3.0.0" } diff --git a/dc-agents/package-lock.json b/dc-agents/package-lock.json index de103363b0dda..8dcbd7ae557a2 100644 --- a/dc-agents/package-lock.json +++ b/dc-agents/package-lock.json @@ -24,7 +24,7 @@ }, "dc-api-types": { "name": "@hasura/dc-api-types", - "version": "0.43.0", + "version": "0.44.0", "license": "Apache-2.0", "devDependencies": { "@tsconfig/node16": "^1.0.3", @@ -2227,7 +2227,7 @@ "license": "Apache-2.0", "dependencies": { "@fastify/cors": "^8.1.0", - "@hasura/dc-api-types": "0.43.0", + "@hasura/dc-api-types": "0.44.0", "fastify": "^4.13.0", "mathjs": "^11.0.0", "pino-pretty": "^8.0.0", @@ -2547,7 +2547,7 @@ "license": "Apache-2.0", "dependencies": { "@fastify/cors": "^8.1.0", - "@hasura/dc-api-types": "0.43.0", + "@hasura/dc-api-types": "0.44.0", "fastify": "^4.13.0", "fastify-metrics": "^9.2.1", "nanoid": "^3.3.4", @@ -2868,7 +2868,7 @@ "version": "file:reference", "requires": { "@fastify/cors": "^8.1.0", - "@hasura/dc-api-types": "0.43.0", + "@hasura/dc-api-types": "0.44.0", "@tsconfig/node16": "^1.0.3", "@types/node": "^16.11.49", "@types/xml2js": "^0.4.11", @@ -3080,7 +3080,7 @@ "version": "file:sqlite", "requires": { "@fastify/cors": "^8.1.0", - "@hasura/dc-api-types": "0.43.0", + "@hasura/dc-api-types": "0.44.0", "@tsconfig/node16": "^1.0.3", "@types/node": "^16.11.49", "@types/sqlite3": "^3.1.8", diff --git a/dc-agents/reference/package-lock.json b/dc-agents/reference/package-lock.json index 99b9245cd5d89..a9d47648f8e61 100644 --- a/dc-agents/reference/package-lock.json +++ b/dc-agents/reference/package-lock.json @@ -10,7 +10,7 @@ "license": "Apache-2.0", "dependencies": { "@fastify/cors": "^8.1.0", - "@hasura/dc-api-types": "0.43.0", + "@hasura/dc-api-types": "0.44.0", "fastify": "^4.13.0", "mathjs": "^11.0.0", "pino-pretty": "^8.0.0", @@ -52,7 +52,7 @@ "integrity": "sha512-lgHwxlxV1qIg1Eap7LgIeoBWIMFibOjbrYPIPJZcI1mmGAI2m3lNYpK12Y+GBdPQ0U1hRwSord7GIaawz962qQ==" }, "node_modules/@hasura/dc-api-types": { - "version": "0.43.0", + "version": "0.44.0", "license": "Apache-2.0", "devDependencies": { "@tsconfig/node16": "^1.0.3", diff --git a/dc-agents/reference/package.json b/dc-agents/reference/package.json index 1c81250787835..b75ab38e9f938 100644 --- a/dc-agents/reference/package.json +++ b/dc-agents/reference/package.json @@ -22,7 +22,7 @@ }, "dependencies": { "@fastify/cors": "^8.1.0", - "@hasura/dc-api-types": "0.43.0", + "@hasura/dc-api-types": "0.44.0", "fastify": "^4.13.0", "mathjs": "^11.0.0", "pino-pretty": "^8.0.0", diff --git a/dc-agents/sqlite/package-lock.json b/dc-agents/sqlite/package-lock.json index 6fb00835c4459..76f73c23bed3c 100644 --- a/dc-agents/sqlite/package-lock.json +++ b/dc-agents/sqlite/package-lock.json @@ -10,7 +10,7 @@ "license": "Apache-2.0", "dependencies": { "@fastify/cors": "^8.1.0", - "@hasura/dc-api-types": "0.43.0", + "@hasura/dc-api-types": "0.44.0", "fastify": "^4.13.0", "fastify-metrics": "^9.2.1", "nanoid": "^3.3.4", @@ -57,7 +57,7 @@ "integrity": "sha512-lgHwxlxV1qIg1Eap7LgIeoBWIMFibOjbrYPIPJZcI1mmGAI2m3lNYpK12Y+GBdPQ0U1hRwSord7GIaawz962qQ==" }, "node_modules/@hasura/dc-api-types": { - "version": "0.43.0", + "version": "0.44.0", "license": "Apache-2.0", "devDependencies": { "@tsconfig/node16": "^1.0.3", diff --git a/dc-agents/sqlite/package.json b/dc-agents/sqlite/package.json index 644797396d9dd..67af6af2631f0 100644 --- a/dc-agents/sqlite/package.json +++ b/dc-agents/sqlite/package.json @@ -22,7 +22,7 @@ }, "dependencies": { "@fastify/cors": "^8.1.0", - "@hasura/dc-api-types": "0.43.0", + "@hasura/dc-api-types": "0.44.0", "fastify-metrics": "^9.2.1", "fastify": "^4.13.0", "nanoid": "^3.3.4", diff --git a/scripts/dev.sh b/scripts/dev.sh index da0ac66ad5975..38a16050a1a1a 100755 --- a/scripts/dev.sh +++ b/scripts/dev.sh @@ -107,9 +107,10 @@ case "${1-}" in if [ "$EDITION_NAME" = "graphql-engine-pro" ];then EDITION_ABBREV=ee if [ -z "${HASURA_GRAPHQL_EE_LICENSE_KEY-}" ]; then - echo_error "You need to have the HASURA_GRAPHQL_EE_LICENSE_KEY environment variable defined." - echo_error "Ask a pro developer for the dev key." - exit 1 + echo_warn "You don't have the HASURA_GRAPHQL_EE_LICENSE_KEY environment variable defined." + echo_warn "Ask a pro developer for the dev key." + echo_warn " Or: Press enter to continue with the pro binary in non-pro mode [will proceed in 15s]" + read -r -t15 || true fi # This is required for pro with EE license available: if [ -z "${HASURA_GRAPHQL_ADMIN_SECRET-}" ]; then diff --git a/server/VERSIONS.json b/server/VERSIONS.json index 250ac871e1e8f..67ceec2fec57d 100644 --- a/server/VERSIONS.json +++ b/server/VERSIONS.json @@ -1,6 +1,6 @@ { "cabal-install": "3.10.1.0", - "ghc": "9.4.5", + "ghc": "9.6.4", "hlint": "3.6.1", "ormolu": "0.7.2.0" } diff --git a/server/forks/hedis/src/Database/Redis/PubSub.hs b/server/forks/hedis/src/Database/Redis/PubSub.hs index 71022b2c6c301..ef1f10a535c05 100644 --- a/server/forks/hedis/src/Database/Redis/PubSub.hs +++ b/server/forks/hedis/src/Database/Redis/PubSub.hs @@ -40,6 +40,7 @@ import qualified Data.HashMap.Strict as HM import qualified Database.Redis.Core as Core import qualified Database.Redis.Connection as Connection import qualified Database.Redis.ProtocolPipelining as PP +import GHC.Conc import Database.Redis.Protocol (Reply(..), renderRequest) import Database.Redis.Types @@ -489,7 +490,9 @@ removeChannelsAndWait ctrl remChans remPChans = do -- This is the only thread which ever receives data from the underlying -- connection. listenThread :: PubSubController -> PP.Connection -> IO () -listenThread ctrl rawConn = forever $ do +listenThread ctrl rawConn = do + labelMe "Redis listenThread" + forever $ do msg <- PP.recv rawConn case decodeMsg msg of Msg (Message channel msgCt) -> do @@ -511,7 +514,9 @@ listenThread ctrl rawConn = forever $ do -- This is the only thread which ever sends data on the underlying -- connection. sendThread :: PubSubController -> PP.Connection -> IO () -sendThread ctrl rawConn = forever $ do +sendThread ctrl rawConn = do + labelMe "Redis sendThread" + forever $ do PubSub{..} <- atomically $ readTBQueue (sendChanges ctrl) rawSendCmd rawConn subs rawSendCmd rawConn unsubs @@ -637,3 +642,6 @@ errMsg r = error $ "Hedis: expected pub/sub-message but got: " ++ show r -- of the public API) are shared, so functions or types in one of the following sections cannot -- be used for the other. In particular, be aware that they use different utility functions to subscribe -- and unsubscribe to channels. + +labelMe :: MonadIO m=> String -> m () +labelMe l = liftIO (myThreadId >>= flip labelThread l) diff --git a/server/forks/hedis/src/Database/Redis/Sentinel.hs b/server/forks/hedis/src/Database/Redis/Sentinel.hs index d3a4f0d8fb282..1271bad37bd81 100644 --- a/server/forks/hedis/src/Database/Redis/Sentinel.hs +++ b/server/forks/hedis/src/Database/Redis/Sentinel.hs @@ -44,6 +44,7 @@ module Database.Redis.Sentinel import Control.Concurrent import Control.Exception (Exception, IOException, evaluate, throwIO) import Control.Monad +import Control.Monad.IO.Class import Control.Monad.Catch (Handler (..), MonadCatch, catches, throwM) import Control.Monad.Except import Data.ByteString (ByteString) diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index f373212748773..53bdb8adf2303 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -191,12 +191,9 @@ common common-all -- in the graphql-engine 'executable' stanza below, and in any other dependent -- executables (See mono #2610): -fexpose-all-unfoldings - -- Use O1 over O2, as (as of writing) it improves compile times a little, without - -- hurting performance: - -O1 - -- This seems like a better default for us, lowering memory residency without - -- impacting compile times too much, though it does increase binary size: - -funfolding-use-threshold=640 + -O2 + -- This is lowered to limit compile time and binary size (default 80) + -funfolding-use-threshold=40 else -- we just want to build fast: ghc-options: -O0 diff --git a/server/lib/api-tests/src-feature-matrix/Hasura/FeatureMatrix.hs b/server/lib/api-tests/src-feature-matrix/Hasura/FeatureMatrix.hs index 2922be630b636..384b60f4b200b 100644 --- a/server/lib/api-tests/src-feature-matrix/Hasura/FeatureMatrix.hs +++ b/server/lib/api-tests/src-feature-matrix/Hasura/FeatureMatrix.hs @@ -1,6 +1,7 @@ module Hasura.FeatureMatrix (render, parseLogs, extractFeatures, renderFeatureMatrix) where import Control.Applicative +import Control.Monad (unless, void) import Control.Monad.Except import Control.Monad.State import Data.Aeson diff --git a/server/lib/dc-api/test/Test/AgentClient.hs b/server/lib/dc-api/test/Test/AgentClient.hs index 4994ce39e9d85..f567083768fe9 100644 --- a/server/lib/dc-api/test/Test/AgentClient.hs +++ b/server/lib/dc-api/test/Test/AgentClient.hs @@ -153,7 +153,7 @@ runRequestAcceptStatus' acceptStatus request = do let phaseNamePrefix = maybe "" (<> "-") _acsPhaseName let filenamePrefix = printf "%s%02d" (Text.unpack phaseNamePrefix) _acsRequestCounter - let clientRequest = addHeaderRedaction _accSensitiveOutputHandling $ defaultMakeClientRequest _accBaseUrl request + clientRequest <- liftIO $ addHeaderRedaction _accSensitiveOutputHandling <$> defaultMakeClientRequest _accBaseUrl request testFolder <- getCurrentFolder -- HttpClient modifies the request with settings from the Manager before it sends it. To log these modifications diff --git a/server/lib/dc-api/test/Test/Specs/QuerySpec/CustomOperatorsSpec.hs b/server/lib/dc-api/test/Test/Specs/QuerySpec/CustomOperatorsSpec.hs index 989039f807474..b84d9c284c2da 100644 --- a/server/lib/dc-api/test/Test/Specs/QuerySpec/CustomOperatorsSpec.hs +++ b/server/lib/dc-api/test/Test/Specs/QuerySpec/CustomOperatorsSpec.hs @@ -1,8 +1,7 @@ module Test.Specs.QuerySpec.CustomOperatorsSpec (spec) where import Control.Lens ((&), (?~)) -import Control.Monad (forM_) -import Control.Monad.List (guard) +import Control.Monad import Data.HashMap.Strict qualified as HashMap import Data.Maybe (maybeToList) import Data.Text qualified as Text diff --git a/server/lib/ekg-prometheus/System/Metrics/Prometheus.hs b/server/lib/ekg-prometheus/System/Metrics/Prometheus.hs index 86fdc3f17a30d..77111bb75c612 100644 --- a/server/lib/ekg-prometheus/System/Metrics/Prometheus.hs +++ b/server/lib/ekg-prometheus/System/Metrics/Prometheus.hs @@ -1093,7 +1093,8 @@ emptyGCDetails = gcdetails_cpu_ns = 0, gcdetails_elapsed_ns = 0, gcdetails_nonmoving_gc_sync_cpu_ns = 0, - gcdetails_nonmoving_gc_sync_elapsed_ns = 0 + gcdetails_nonmoving_gc_sync_elapsed_ns = 0, + gcdetails_block_fragmentation_bytes = 0 } -- | The metrics registered by `registerGcMetrics`. These metrics are the diff --git a/server/lib/ekg-prometheus/ekg-prometheus.cabal b/server/lib/ekg-prometheus/ekg-prometheus.cabal index c441402fed355..b751aa09507f4 100644 --- a/server/lib/ekg-prometheus/ekg-prometheus.cabal +++ b/server/lib/ekg-prometheus/ekg-prometheus.cabal @@ -74,7 +74,7 @@ benchmark counter base, ekg-prometheus, ekg-prometheus-benchmark, - criterion ^>= 1.5.9.0 + criterion hs-source-dirs: benchmark-exe ghc-options: -O2 -threaded diff --git a/server/lib/hasura-base/src/Hasura/Base/Instances.hs b/server/lib/hasura-base/src/Hasura/Base/Instances.hs index 72d014a06c3c6..c431531f81b53 100644 --- a/server/lib/hasura-base/src/Hasura/Base/Instances.hs +++ b/server/lib/hasura-base/src/Hasura/Base/Instances.hs @@ -6,6 +6,7 @@ module Hasura.Base.Instances () where import Autodocodec qualified as AC +import Control.Monad.Fail import Control.Monad.Fix import Data.Aeson qualified as J import Data.ByteString (ByteString) diff --git a/server/lib/hasura-extras/hasura-extras.cabal b/server/lib/hasura-extras/hasura-extras.cabal index 08e835ab9b34f..7ad39147b44dc 100644 --- a/server/lib/hasura-extras/hasura-extras.cabal +++ b/server/lib/hasura-extras/hasura-extras.cabal @@ -4,6 +4,11 @@ version: 1.0.0 build-type: Simple copyright: Hasura Inc. +flag profiling + description: Configures the project to be profiling-compatible + default: False + manual: True + library hs-source-dirs: src default-language: GHC2021 @@ -40,6 +45,11 @@ library -Wno-redundant-bang-patterns -Wno-unused-type-patterns + if !flag(profiling) + -- ghc-heap-view can't be built with profiling + build-depends: ghc-heap-view + else + cpp-options: -DPROFILING build-depends: , QuickCheck , aeson @@ -57,7 +67,6 @@ library , data-default-class , deepseq , exceptions - , ghc-heap-view , graphql-parser , hashable , hasura-prelude diff --git a/server/lib/hasura-extras/src/Data/Parser/CacheControl.hs b/server/lib/hasura-extras/src/Data/Parser/CacheControl.hs index c220de132d976..f7c0537d05556 100644 --- a/server/lib/hasura-extras/src/Data/Parser/CacheControl.hs +++ b/server/lib/hasura-extras/src/Data/Parser/CacheControl.hs @@ -18,6 +18,7 @@ module Data.Parser.CacheControl ) where +import Control.Monad import Data.Attoparsec.Text qualified as AT import Data.Bifunctor (first) import Data.Text qualified as T diff --git a/server/lib/hasura-extras/src/Data/Parser/JSONPath.hs b/server/lib/hasura-extras/src/Data/Parser/JSONPath.hs index 724973d9a438d..f874fcfb5044c 100644 --- a/server/lib/hasura-extras/src/Data/Parser/JSONPath.hs +++ b/server/lib/hasura-extras/src/Data/Parser/JSONPath.hs @@ -5,6 +5,7 @@ module Data.Parser.JSONPath where import Control.Applicative +import Control.Monad import Data.Aeson (Key) import Data.Aeson qualified as J import Data.Aeson.Key qualified as K diff --git a/server/lib/hasura-extras/src/Network/URI/Extended.hs b/server/lib/hasura-extras/src/Network/URI/Extended.hs index ba9fd110af6c8..4078df127e92b 100644 --- a/server/lib/hasura-extras/src/Network/URI/Extended.hs +++ b/server/lib/hasura-extras/src/Network/URI/Extended.hs @@ -5,6 +5,7 @@ module Network.URI.Extended ) where +import Control.Monad import Data.Aeson import Data.Aeson.Types import Data.Hashable diff --git a/server/lib/hasura-extras/src/System/Monitor/Heartbeat.hs b/server/lib/hasura-extras/src/System/Monitor/Heartbeat.hs index 9ddfeef7fd45a..1e88661debdc9 100644 --- a/server/lib/hasura-extras/src/System/Monitor/Heartbeat.hs +++ b/server/lib/hasura-extras/src/System/Monitor/Heartbeat.hs @@ -36,6 +36,7 @@ import Data.Char import Data.IORef import Data.Time import Data.Typeable +import GHC.Conc import GHC.Generics import Options.Generic import System.Environment @@ -66,22 +67,24 @@ monitorHeartbeat :: HeartbeatOptions Unwrapped -> IO () monitorHeartbeat HeartbeatOptions {..} = do mainThread <- myThreadId check <- heartbeatChecker hoSource - void $ forkIO $ while $ do - threadDelay (hoFrequencySeconds * 10 ^ (6 :: Int)) - - latestBeat <- check - now <- getCurrentTime - - let missedBeats = - (now `diffUTCTime` latestBeat) - / secondsToNominalDiffTime (fromIntegral hoFrequencySeconds) - - if (missedBeats > 2) - then do - putStrLn "Heartbeats have stopped - Exiting" - throwTo mainThread ExitSuccess - return False - else return True + void $ forkIO $ do + labelMe "monitorHeartbeat" + while $ do + threadDelay (hoFrequencySeconds * 10 ^ (6 :: Int)) + + latestBeat <- check + now <- getCurrentTime + + let missedBeats = + (now `diffUTCTime` latestBeat) + / secondsToNominalDiffTime (fromIntegral hoFrequencySeconds) + + if (missedBeats > 2) + then do + putStrLn "Heartbeats have stopped - Exiting" + throwTo mainThread ExitSuccess + return False + else return True where while body = do cond <- body @@ -91,13 +94,15 @@ heartbeatChecker :: HeartbeatSource -> IO (IO UTCTime) heartbeatChecker StdInSource = do start <- getCurrentTime lastHeartbeat <- newIORef start - void $ forkIO $ forever $ do - hb <- getLine - case hb of - "HB" -> do - now <- getCurrentTime - writeIORef lastHeartbeat now - _ -> return () + void $ forkIO $ do + labelMe "heartbeatChecker" + forever $ do + hb <- getLine + case hb of + "HB" -> do + now <- getCurrentTime + writeIORef lastHeartbeat now + _ -> return () return $ readIORef lastHeartbeat @@ -159,7 +164,12 @@ emitHeartbeatHandle h = do -- thread. heartbeatThread :: IO () -> Int -> IO (IO ()) heartbeatThread emitHeartbeat frequencySeconds = do - threadHandle <- Async.async $ forever $ do - emitHeartbeat - threadDelay (frequencySeconds * 10 ^ (6 :: Int)) + threadHandle <- Async.async $ do + labelMe "heartbeatThread" + forever $ do + emitHeartbeat + threadDelay (frequencySeconds * 10 ^ (6 :: Int)) return (Async.cancel threadHandle) + +labelMe :: String -> IO () +labelMe l = myThreadId >>= flip labelThread l diff --git a/server/lib/hasura-prelude/src/Hasura/Prelude.hs b/server/lib/hasura-prelude/src/Hasura/Prelude.hs index 00bae557104e4..0fce7de1337e0 100644 --- a/server/lib/hasura-prelude/src/Hasura/Prelude.hs +++ b/server/lib/hasura-prelude/src/Hasura/Prelude.hs @@ -68,6 +68,7 @@ module Hasura.Prelude findWithIndex, alphabet, alphaNumerics, + labelMe, -- * Extensions to @Data.Foldable@ module Data.Time.Clock.Units, @@ -80,8 +81,11 @@ import Control.Applicative as M (Alternative (..), liftA2) import Control.Arrow as M (first, second, (&&&), (***), (<<<), (>>>)) import Control.DeepSeq as M (NFData, deepseq, force) import Control.Lens as M (ix, (%~)) +import Control.Monad as M import Control.Monad.Base as M import Control.Monad.Except as M +import Control.Monad.Fix as M +import Control.Monad.IO.Class as M import Control.Monad.Identity as M import Control.Monad.Reader as M import Control.Monad.State.Strict as M @@ -163,6 +167,7 @@ import Data.Void as M (Void, absurd) import Data.Word as M (Word64) import Debug.Trace qualified as Debug (trace, traceM) import GHC.Clock qualified as Clock +import GHC.Conc import GHC.Generics as M (Generic) import System.IO.Unsafe (unsafePerformIO) -- for custom trace functions import Text.Pretty.Simple qualified as PS @@ -430,3 +435,7 @@ alphabet = ['a' .. 'z'] ++ ['A' .. 'Z'] {-# NOINLINE alphaNumerics #-} alphaNumerics :: String alphaNumerics = alphabet ++ "0123456789" + +-- | 'labelThread' on this thread +labelMe :: (MonadIO m) => String -> m () +labelMe l = liftIO (myThreadId >>= flip labelThread l) diff --git a/server/lib/incremental/test/Hasura/IncrementalSpec.hs b/server/lib/incremental/test/Hasura/IncrementalSpec.hs index 43a191e5fd8f6..9333f59ac3d7a 100644 --- a/server/lib/incremental/test/Hasura/IncrementalSpec.hs +++ b/server/lib/incremental/test/Hasura/IncrementalSpec.hs @@ -1,4 +1,6 @@ {-# LANGUAGE Arrows #-} +-- new warning in 9.6 here mentions constraints not in this file...?: +{-# OPTIONS_GHC -Wno-redundant-constraints #-} module Hasura.IncrementalSpec (spec) where diff --git a/server/lib/pg-client/src/Control/Concurrent/Interrupt.hs b/server/lib/pg-client/src/Control/Concurrent/Interrupt.hs index bdedffb6dbed4..90fd194ef736b 100644 --- a/server/lib/pg-client/src/Control/Concurrent/Interrupt.hs +++ b/server/lib/pg-client/src/Control/Concurrent/Interrupt.hs @@ -13,9 +13,9 @@ import Control.Exception SomeException, mask, throwIO, - throwTo, try, ) +import GHC.Conc import Prelude ------------------------------------------------------------------------------- @@ -34,7 +34,7 @@ import Prelude -- provide some cancelling escape hatch. interruptOnAsyncException :: IO () -> IO a -> IO a interruptOnAsyncException interrupt action = mask $ \restore -> do - x <- async action + x <- async (labelMe "interruptOnAsyncException" >> action) -- By using 'try' with 'waitCatch', we can distinguish between asynchronous -- exceptions received from the outside, and those thrown by the wrapped action. @@ -70,3 +70,6 @@ interruptOnAsyncException interrupt action = mask $ \restore -> do throwIO e Right (Right r) -> pure r + +labelMe :: String -> IO () +labelMe l = myThreadId >>= flip labelThread l diff --git a/server/lib/pg-client/src/Database/PG/Query/Listen.hs b/server/lib/pg-client/src/Database/PG/Query/Listen.hs index 900a2f85d5db5..d059ed4437065 100644 --- a/server/lib/pg-client/src/Database/PG/Query/Listen.hs +++ b/server/lib/pg-client/src/Database/PG/Query/Listen.hs @@ -23,7 +23,10 @@ where import Control.Concurrent (threadWaitRead) import Control.Exception.Safe (displayException, try) +import Control.Monad import Control.Monad.Except +import Control.Monad.IO.Class +import Control.Monad.Trans.Class import Data.Foldable import Data.String (IsString) import Data.Text qualified as T diff --git a/server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Directives.hs b/server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Directives.hs index 3a8a0fff5e2eb..dadb20ab4c686 100644 --- a/server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Directives.hs +++ b/server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Directives.hs @@ -46,7 +46,7 @@ import Hasura.GraphQL.Parser.Internal.Scalars import Hasura.GraphQL.Parser.Schema import Hasura.GraphQL.Parser.Variable import Language.GraphQL.Draft.Syntax qualified as G -import Type.Reflection (Typeable, typeRep) +import Type.Reflection (Typeable, typeRep, (:~:) (Refl)) import Witherable (catMaybes) import Prelude diff --git a/server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Internal/Input.hs b/server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Internal/Input.hs index 29c82e8b796b4..55111df978998 100644 --- a/server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Internal/Input.hs +++ b/server/lib/schema-parsers/src/Hasura/GraphQL/Parser/Internal/Input.hs @@ -17,7 +17,7 @@ module Hasura.GraphQL.Parser.Internal.Input ) where -import Control.Applicative (Alternative ((<|>)), liftA2) +import Control.Applicative (Alternative ((<|>))) import Control.Arrow ((>>>)) import Control.Lens hiding (enum, index) import Control.Monad (join, unless, (<=<), (>=>)) diff --git a/server/lib/test-harness/src/Harness/Backend/Citus.hs b/server/lib/test-harness/src/Harness/Backend/Citus.hs index e426d509cf86e..f7076609d6565 100644 --- a/server/lib/test-harness/src/Harness/Backend/Citus.hs +++ b/server/lib/test-harness/src/Harness/Backend/Citus.hs @@ -24,7 +24,6 @@ where -------------------------------------------------------------------------------- import Control.Concurrent.Extended (sleep) -import Control.Monad.Reader import Data.Aeson (Value) import Data.ByteString.Char8 qualified as S8 import Data.String (fromString) diff --git a/server/lib/test-harness/src/Harness/Backend/Cockroach.hs b/server/lib/test-harness/src/Harness/Backend/Cockroach.hs index 575ff1cf5dab9..71720638dbabc 100644 --- a/server/lib/test-harness/src/Harness/Backend/Cockroach.hs +++ b/server/lib/test-harness/src/Harness/Backend/Cockroach.hs @@ -24,7 +24,6 @@ where -------------------------------------------------------------------------------- import Control.Concurrent.Extended (sleep) -import Control.Monad.Reader import Data.Aeson (Value) import Data.ByteString.Char8 qualified as S8 import Data.String (fromString) diff --git a/server/lib/test-harness/src/Harness/Backend/Postgres.hs b/server/lib/test-harness/src/Harness/Backend/Postgres.hs index 1b50d0a0ddeb6..fea31e6e01703 100644 --- a/server/lib/test-harness/src/Harness/Backend/Postgres.hs +++ b/server/lib/test-harness/src/Harness/Backend/Postgres.hs @@ -42,7 +42,6 @@ where -------------------------------------------------------------------------------- import Control.Concurrent.Extended (sleep) -import Control.Monad.Reader import Data.Aeson (Value) import Data.Aeson qualified as J import Data.Monoid (Last (..)) diff --git a/server/lib/test-harness/src/Harness/Backend/Sqlserver.hs b/server/lib/test-harness/src/Harness/Backend/Sqlserver.hs index daff518a3a6f4..086d114c7780f 100644 --- a/server/lib/test-harness/src/Harness/Backend/Sqlserver.hs +++ b/server/lib/test-harness/src/Harness/Backend/Sqlserver.hs @@ -23,7 +23,6 @@ where -------------------------------------------------------------------------------- import Control.Concurrent.Extended (sleep) -import Control.Monad.Reader import Data.Aeson (Value) import Data.String (fromString) import Data.String.Interpolate (i) diff --git a/server/lib/test-harness/src/Harness/Logging/Messages.hs b/server/lib/test-harness/src/Harness/Logging/Messages.hs index e92a0a6f1c18c..6d5dea1cc0841 100644 --- a/server/lib/test-harness/src/Harness/Logging/Messages.hs +++ b/server/lib/test-harness/src/Harness/Logging/Messages.hs @@ -162,6 +162,11 @@ instance LoggableMessage LogHspecEvent where encFailureReason :: FailureReason -> Value encFailureReason = \case NoReason -> object [("failure_reason", String "NoReason")] + ColorizedReason reason -> + object + [ ("failure_reason", String "Reason"), + ("reason", toJSON reason) + ] Reason reason -> object [ ("failure_reason", String "Reason"), diff --git a/server/lib/test-harness/src/Harness/Quoter/Yaml.hs b/server/lib/test-harness/src/Harness/Quoter/Yaml.hs index 5f44338ae7cda..d5ffc48cc5dc7 100644 --- a/server/lib/test-harness/src/Harness/Quoter/Yaml.hs +++ b/server/lib/test-harness/src/Harness/Quoter/Yaml.hs @@ -12,7 +12,6 @@ module Harness.Quoter.Yaml where import Control.Exception.Safe (Exception, impureThrow, throwM) -import Control.Monad.Identity import Control.Monad.Trans.Resource (ResourceT) import Data.Aeson qualified as J import Data.Conduit (runConduitRes, (.|)) diff --git a/server/src-lib/Control/Monad/Circular.hs b/server/src-lib/Control/Monad/Circular.hs index abb06467f0351..d99eb4b7bbed9 100644 --- a/server/src-lib/Control/Monad/Circular.hs +++ b/server/src-lib/Control/Monad/Circular.hs @@ -85,10 +85,8 @@ import Control.Monad.Except import Control.Monad.Reader import Control.Monad.State.Strict import Control.Monad.Writer.Strict -import Data.HashMap.Lazy (HashMap) import Data.HashMap.Lazy qualified as Map -import Data.Hashable (Hashable) -import Prelude +import Hasura.Prelude -- | CircularT is implemented as a state monad containing a lazy HashMap. -- diff --git a/server/src-lib/Control/Monad/Memoize.hs b/server/src-lib/Control/Monad/Memoize.hs index ad405a5a6f37a..f22d46ccacbe5 100644 --- a/server/src-lib/Control/Monad/Memoize.hs +++ b/server/src-lib/Control/Monad/Memoize.hs @@ -1,4 +1,6 @@ {-# LANGUAGE UndecidableInstances #-} +-- ghc 9.6 seems to be doing something screwy with... +{-# OPTIONS_GHC -Wno-redundant-constraints #-} module Control.Monad.Memoize ( MonadMemoize (..), @@ -9,18 +11,16 @@ module Control.Monad.Memoize where import Control.Monad.Except -import Control.Monad.Reader (MonadReader, ReaderT, mapReaderT) -import Control.Monad.State.Strict (MonadState (..), StateT, evalStateT) import Data.Dependent.Map (DMap) import Data.Dependent.Map qualified as DM import Data.Functor.Identity import Data.GADT.Compare.Extended import Data.IORef import Data.Kind qualified as K +import Hasura.Prelude import Language.Haskell.TH qualified as TH import System.IO.Unsafe (unsafeInterleaveIO) -import Type.Reflection (Typeable, typeRep) -import Prelude +import Type.Reflection (Typeable, typeRep, (:~:) (Refl)) {- Note [Tying the knot] ~~~~~~~~~~~~~~~~~~~~~~~~ @@ -174,16 +174,17 @@ instance -- the point at which the effect is performed can be unpredictable. But -- this action just reads, never writes, so that isn’t a concern. parserById <- - liftIO $ - unsafeInterleaveIO $ - readIORef cell >>= \case - Just parser -> pure $ Identity parser - Nothing -> - error $ - unlines - [ "memoize: parser was forced before being fully constructed", - " parser constructor: " ++ TH.pprint name - ] + liftIO + $ unsafeInterleaveIO + $ readIORef cell + >>= \case + Just parser -> pure $ Identity parser + Nothing -> + error + $ unlines + [ "memoize: parser was forced before being fully constructed", + " parser constructor: " ++ TH.pprint name + ] put $! DM.insert parserId parserById parsersById parser <- unMemoizeT buildParser diff --git a/server/src-lib/Control/Monad/Trans/Extended.hs b/server/src-lib/Control/Monad/Trans/Extended.hs index 6759538b63a5d..e3a4ea857d055 100644 --- a/server/src-lib/Control/Monad/Trans/Extended.hs +++ b/server/src-lib/Control/Monad/Trans/Extended.hs @@ -1,3 +1,6 @@ +-- ghc 9.6 seems to be doing something screwy with... +{-# OPTIONS_GHC -Wno-redundant-constraints #-} + module Control.Monad.Trans.Extended ( TransT (..), ) diff --git a/server/src-lib/Control/Monad/Trans/Managed.hs b/server/src-lib/Control/Monad/Trans/Managed.hs index 6601a349aefcc..44ed16e6dd094 100644 --- a/server/src-lib/Control/Monad/Trans/Managed.hs +++ b/server/src-lib/Control/Monad/Trans/Managed.hs @@ -1,3 +1,6 @@ +-- ghc 9.6 seems to be doing something screwy with... +{-# OPTIONS_GHC -Wno-redundant-constraints #-} + module Control.Monad.Trans.Managed ( ManagedT (..), allocate, diff --git a/server/src-lib/Hasura/App.hs b/server/src-lib/Hasura/App.hs index 9e1896b526bf1..58b9f94e0defd 100644 --- a/server/src-lib/Hasura/App.hs +++ b/server/src-lib/Hasura/App.hs @@ -982,7 +982,8 @@ runHGEServer setupHook appStateRef initTime startupStatusHook consoleType ekgSto setForkIOWithMetrics = Warp.setFork \f -> do void $ C.forkIOWithUnmask - ( \unmask -> + ( \unmask -> do + labelMe "runHGEServer_warp_fork" bracket_ ( do EKG.Gauge.inc (smWarpThreads appEnvServerMetrics) diff --git a/server/src-lib/Hasura/App/State.hs b/server/src-lib/Hasura/App/State.hs index b2313641f4d46..22525c8a4af4a 100644 --- a/server/src-lib/Hasura/App/State.hs +++ b/server/src-lib/Hasura/App/State.hs @@ -1,4 +1,5 @@ {-# LANGUAGE Arrows #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} module Hasura.App.State ( -- * application state diff --git a/server/src-lib/Hasura/Backends/DataConnector/Agent/Client.hs b/server/src-lib/Hasura/Backends/DataConnector/Agent/Client.hs index e5068e0fc6ba3..fc0c6767b21b2 100644 --- a/server/src-lib/Hasura/Backends/DataConnector/Agent/Client.hs +++ b/server/src-lib/Hasura/Backends/DataConnector/Agent/Client.hs @@ -64,7 +64,7 @@ instance (MonadIO m, MonadTrace m, MonadError QErr m) => RunClient (AgentClientT runRequestAcceptStatus' :: (MonadIO m, MonadTrace m, MonadError QErr m) => Maybe [Status] -> Request -> (AgentClientT m) Response runRequestAcceptStatus' acceptStatus req = do AgentClientContext {..} <- askClientContext - let transformableReq = defaultMakeClientRequest _accBaseUrl req + transformableReq <- liftIO $ defaultMakeClientRequest _accBaseUrl req -- Set the response timeout explicitly if it is provided let transformableReq' = diff --git a/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Aliases.hs b/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Aliases.hs index bc9a8bae4d69f..f5bdf59ea4f40 100644 --- a/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Aliases.hs +++ b/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Aliases.hs @@ -15,7 +15,6 @@ module Hasura.Backends.Postgres.Translate.Select.Internal.Aliases ) where -import Control.Monad.Writer.Strict import Data.HashMap.Strict qualified as HashMap import Data.Text qualified as T import Data.Text.Extended diff --git a/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Extractor.hs b/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Extractor.hs index 45d56c8cc5add..bfa0c7950dc29 100644 --- a/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Extractor.hs +++ b/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Internal/Extractor.hs @@ -12,7 +12,6 @@ module Hasura.Backends.Postgres.Translate.Select.Internal.Extractor where import Control.Monad.Extra (concatMapM) -import Control.Monad.Writer.Strict import Data.List.NonEmpty qualified as NE import Hasura.Backends.Postgres.SQL.DML qualified as S import Hasura.Backends.Postgres.SQL.Types diff --git a/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Streaming.hs b/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Streaming.hs index d589e07961736..ba66338e2bb51 100644 --- a/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Streaming.hs +++ b/server/src-lib/Hasura/Backends/Postgres/Translate/Select/Streaming.hs @@ -101,11 +101,13 @@ mkStreamSQLSelect userInfo (AnnSelectStreamG () fields from perm args strfyNum) ["cursor", G.unName $ ciName cursorColInfo] in BoolField $ AVColumn cursorColInfo (_sciRedactionExpression cursorArg) [(orderByOpExp sqlExp)] selectArgs = - noSelectArgs + SelectArgs { _saWhere = Just $ maybe cursorBoolExp (andAnnBoolExps cursorBoolExp) $ _ssaWhere args, _saOrderBy = orderByItems, - _saLimit = Just $ _ssaBatchSize args + _saLimit = Just $ _ssaBatchSize args, + _saOffset = Nothing, + _saDistinct = Nothing } sqlSelect = AnnSelectG fields from perm selectArgs strfyNum Nothing permLimitSubQuery = PLSQNotRequired diff --git a/server/src-lib/Hasura/Eventing/EventTrigger.hs b/server/src-lib/Hasura/Eventing/EventTrigger.hs index fe7d0c7f3a1f9..21aa3a678686e 100644 --- a/server/src-lib/Hasura/Eventing/EventTrigger.hs +++ b/server/src-lib/Hasura/Eventing/EventTrigger.hs @@ -318,6 +318,7 @@ processEventQueue logger statsLogger httpMgr getSchemaCache getEventEngineCtx ac where popEventsBatch :: m [BackendEventWithSource] popEventsBatch = do + labelMe "popEventsBatch" {- SELECT FOR UPDATE .. SKIP LOCKED can throw serialization errors in RepeatableRead: https://stackoverflow.com/a/53289263/1911889 We can avoid this safely by running it in ReadCommitted as Postgres will recheck the @@ -334,7 +335,8 @@ processEventQueue logger statsLogger httpMgr getSchemaCache getEventEngineCtx ac . fmap concat $ -- fetch pending events across all the sources asynchronously - LA.forConcurrently (HashMap.toList allSources) \(sourceName, sourceCache) -> + LA.forConcurrently (HashMap.toList allSources) \(sourceName, sourceCache) -> do + labelMe "processEventQueue forConcurrently" AB.dispatchAnyBackend @BackendEventTrigger sourceCache \(SourceInfo {..} :: SourceInfo b) -> do let tables = HashMap.elems _siTables triggerMap = _tiEventTriggerInfoMap <$> tables @@ -403,12 +405,13 @@ processEventQueue logger statsLogger httpMgr getSchemaCache getEventEngineCtx ac modifyTVar' activeEventProcessingThreads (+ 1) -- since there is some capacity in our worker threads, we can launch another: t <- - LA.async - $ flip runReaderT (logger, httpMgr) - $ processEvent eventWithSource' - `finally` - -- NOTE!: this needs to happen IN THE FORKED THREAD: - decrementActiveThreadCount + LA.async $ do + labelMe "processEventQueue t" + flip runReaderT (logger, httpMgr) + $ processEvent eventWithSource' + `finally` + -- NOTE!: this needs to happen IN THE FORKED THREAD: + decrementActiveThreadCount LA.link t -- return when next batch ready; some 'processEvent' threads may be running. diff --git a/server/src-lib/Hasura/GraphQL/Schema/Common.hs b/server/src-lib/Hasura/GraphQL/Schema/Common.hs index a18d7bd621bbc..0207ca8ceedf3 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Common.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Common.hs @@ -1,5 +1,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} +-- ghc 9.6 seems to be doing something screwy with... +{-# OPTIONS_GHC -Wno-redundant-constraints #-} module Hasura.GraphQL.Schema.Common ( SchemaContext (..), diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Protocol.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Protocol.hs index 2d90d6fca4658..c863d009e2f4a 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Protocol.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Protocol.hs @@ -330,6 +330,7 @@ getNewWSTimer timeout = do void $ forkIO $ do + labelMe "getNewWSTimer" sleep (seconds timeout) atomically $ do runTimerState <- readTVar timerState diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs index d6091c0385a6c..4e5b02409e888 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs @@ -602,63 +602,67 @@ createServerApp getMetricsConfig wsConnInitTimeout (WSServer logger@(L.Logger wr forceConnReconnect wsConn "shutting server down" closeHandler wsConn AcceptingConns _ -> do - let rcv = forever $ do - shouldCaptureVariables <- liftIO $ _mcAnalyzeQueryVariables <$> getMetricsConfig - -- Process all messages serially (important!), in a separate thread: - msg <- + let rcv = do + labelMe "WebSocket rcv" + forever $ do + shouldCaptureVariables <- liftIO $ _mcAnalyzeQueryVariables <$> getMetricsConfig + -- Process all messages serially (important!), in a separate thread: + msg <- + liftIO + $ + -- Re-throw "receiveloop: resource vanished (Connection reset by peer)" : + -- https://github.com/yesodweb/wai/blob/master/warp/Network/Wai/Handler/Warp/Recv.hs#L112 + -- as WS exception signaling cleanup below. It's not clear why exactly this gets + -- raised occasionally; I suspect an equivalent handler is missing from WS itself. + -- Regardless this should be safe: + handleJust (guard . E.isResourceVanishedError) (\() -> throw WS.ConnectionClosed) + $ WS.receiveData conn + let messageLength = BL.length msg + censoredMessage = + MessageDetails + (SB.fromLBS (if shouldCaptureVariables then msg else "")) + messageLength liftIO - $ - -- Re-throw "receiveloop: resource vanished (Connection reset by peer)" : - -- https://github.com/yesodweb/wai/blob/master/warp/Network/Wai/Handler/Warp/Recv.hs#L112 - -- as WS exception signaling cleanup below. It's not clear why exactly this gets - -- raised occasionally; I suspect an equivalent handler is missing from WS itself. - -- Regardless this should be safe: - handleJust (guard . E.isResourceVanishedError) (\() -> throw WS.ConnectionClosed) - $ WS.receiveData conn - let messageLength = BL.length msg - censoredMessage = - MessageDetails - (SB.fromLBS (if shouldCaptureVariables then msg else "")) - messageLength - liftIO - $ Prometheus.Counter.add - (pmWebSocketBytesReceived prometheusMetrics) - messageLength - logWSLog logger $ WSLog wsId (EMessageReceived censoredMessage) Nothing - messageHandler wsConn msg subProtocol - - let send = forever $ do - WSQueueResponse msg wsInfo wsTimer <- liftIO $ STM.atomically $ STM.readTQueue sendQ - messageQueueTime <- liftIO $ realToFrac <$> wsTimer - (messageWriteTime, _) <- liftIO $ withElapsedTime $ WS.sendTextData conn msg - let messageLength = BL.length msg - messageDetails = MessageDetails (SB.fromLBS msg) messageLength - parameterizedQueryHash = wsInfo >>= _wseiParameterizedQueryHash - operationName = wsInfo >>= _wseiOperationName - promMetricGranularLabel = DynamicSubscriptionLabel parameterizedQueryHash operationName - promMetricLabel = DynamicSubscriptionLabel Nothing Nothing - websocketBytesSentMetric = pmWebSocketBytesSent prometheusMetrics - granularPrometheusMetricsState <- runGetPrometheusMetricsGranularity - liftIO $ do - recordMetricWithLabel - granularPrometheusMetricsState - True - (CounterVector.add websocketBytesSentMetric promMetricGranularLabel messageLength) - (CounterVector.add websocketBytesSentMetric promMetricLabel messageLength) - Prometheus.Histogram.observe - (pmWebsocketMsgQueueTimeSeconds prometheusMetrics) - messageQueueTime - Prometheus.Histogram.observe - (pmWebsocketMsgWriteTimeSeconds prometheusMetrics) - (realToFrac messageWriteTime) - logWSLog logger $ WSLog wsId (EMessageSent messageDetails) wsInfo + $ Prometheus.Counter.add + (pmWebSocketBytesReceived prometheusMetrics) + messageLength + logWSLog logger $ WSLog wsId (EMessageReceived censoredMessage) Nothing + messageHandler wsConn msg subProtocol + + let send = do + labelMe "WebSocket send" + forever $ do + WSQueueResponse msg wsInfo wsTimer <- liftIO $ STM.atomically $ STM.readTQueue sendQ + messageQueueTime <- liftIO $ realToFrac <$> wsTimer + (messageWriteTime, _) <- liftIO $ withElapsedTime $ WS.sendTextData conn msg + let messageLength = BL.length msg + messageDetails = MessageDetails (SB.fromLBS msg) messageLength + parameterizedQueryHash = wsInfo >>= _wseiParameterizedQueryHash + operationName = wsInfo >>= _wseiOperationName + promMetricGranularLabel = DynamicSubscriptionLabel parameterizedQueryHash operationName + promMetricLabel = DynamicSubscriptionLabel Nothing Nothing + websocketBytesSentMetric = pmWebSocketBytesSent prometheusMetrics + granularPrometheusMetricsState <- runGetPrometheusMetricsGranularity + liftIO $ do + recordMetricWithLabel + granularPrometheusMetricsState + True + (CounterVector.add websocketBytesSentMetric promMetricGranularLabel messageLength) + (CounterVector.add websocketBytesSentMetric promMetricLabel messageLength) + Prometheus.Histogram.observe + (pmWebsocketMsgQueueTimeSeconds prometheusMetrics) + messageQueueTime + Prometheus.Histogram.observe + (pmWebsocketMsgWriteTimeSeconds prometheusMetrics) + (realToFrac messageWriteTime) + logWSLog logger $ WSLog wsId (EMessageSent messageDetails) wsInfo -- withAsync lets us be very sure that if e.g. an async exception is raised while we're -- forking that the threads we launched will be cleaned up. See also below. LA.withAsync rcv $ \rcvRef -> do LA.withAsync send $ \sendRef -> do - LA.withAsync (liftIO $ keepAlive wsConn) $ \keepAliveRef -> do - LA.withAsync (liftIO $ onJwtExpiry wsConn) $ \onJwtExpiryRef -> do + LA.withAsync (liftIO $ labelMe "WebSocket keepAlive" >> keepAlive wsConn) $ \keepAliveRef -> do + LA.withAsync (liftIO $ labelMe "WebSocket onJwtExpiry" >> onJwtExpiry wsConn) $ \onJwtExpiryRef -> do -- once connection is accepted, check the status of the timer, and if it's expired, close the connection for `graphql-ws` timeoutStatus <- liftIO $ getWSTimerState wsConnInitTimer when (timeoutStatus == Done && subProtocol == GraphQLWS) diff --git a/server/src-lib/Hasura/LogicalModel/Fields.hs b/server/src-lib/Hasura/LogicalModel/Fields.hs index b0237f8fd8727..83db6ef87c000 100644 --- a/server/src-lib/Hasura/LogicalModel/Fields.hs +++ b/server/src-lib/Hasura/LogicalModel/Fields.hs @@ -1,4 +1,6 @@ {-# LANGUAGE UndecidableInstances #-} +-- ghc 9.6 seems to be doing something screwy with... +{-# OPTIONS_GHC -Wno-redundant-constraints #-} module Hasura.LogicalModel.Fields (LogicalModelFieldsRM (..), LogicalModelFieldsLookupRT (..), runLogicalModelFieldsLookup) where diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index 1b107b094ee6c..1c811b8a3402b 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -2,6 +2,8 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE UndecidableInstances #-} +-- ghc 9.6 seems to be doing something screwy with... +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- | Top-level functions concerned specifically with operations on the schema cache, such as -- rebuilding it from the catalog and incorporating schema changes. See the module documentation for diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Permission.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Permission.hs index 82d1aff8011e2..a54ae7fbe060e 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Permission.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache/Permission.hs @@ -459,8 +459,8 @@ buildLogicalModelSelectPermission sourceName sourceConfig tableCache logicalMode $ SOILogicalModelObj @b logicalModelLocation $ LMOPerm role PTSelect - modifyError :: ExceptT QErr m a -> ExceptT QErr m a - modifyError = modifyErr \err -> + addErrContext :: ExceptT QErr m a -> ExceptT QErr m a + addErrContext = modifyErr \err -> addLogicalModelContext logicalModelLocation $ "in permission for role " <> role @@ -468,7 +468,7 @@ buildLogicalModelSelectPermission sourceName sourceConfig tableCache logicalMode <> err logicalModels <- getLogicalModelFieldsLookup @b - select <- withRecordInconsistencyM metadataObject $ modifyError do + select <- withRecordInconsistencyM metadataObject $ addErrContext do when (role == adminRoleName) $ throw400 ConstraintViolation "cannot define permission for admin role" diff --git a/server/src-lib/Hasura/RQL/DML/Internal.hs b/server/src-lib/Hasura/RQL/DML/Internal.hs index 384301cd75630..2d4ca3a58ab5c 100644 --- a/server/src-lib/Hasura/RQL/DML/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Internal.hs @@ -1,3 +1,6 @@ +-- ghc 9.6 seems to be doing something screwy with... +{-# OPTIONS_GHC -Wno-redundant-constraints #-} + module Hasura.RQL.DML.Internal ( SessionVariableBuilder, askDelPermInfo, diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index c6d6c044ca020..c0b7f7437f35b 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -1,4 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} +-- ghc 9.6 seems to be doing something screwy with... +{-# OPTIONS_GHC -Wno-redundant-constraints #-} module Hasura.RQL.Types.SchemaCache ( SchemaCache (..), diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs index a08cf31daa1f6..30be4f7aff23b 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs @@ -1,6 +1,8 @@ {-# LANGUAGE Arrows #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE UndecidableInstances #-} +-- ghc 9.6 seems to be doing something screwy with... +{-# OPTIONS_GHC -Wno-redundant-constraints #-} -- | Types and functions used in the process of building the schema cache from metadata information -- stored in the @hdb_catalog@ schema in Postgres. diff --git a/server/src-lib/Hasura/RQL/Types/Session.hs b/server/src-lib/Hasura/RQL/Types/Session.hs index 6bdadacb7ceb3..d045f96d8186e 100644 --- a/server/src-lib/Hasura/RQL/Types/Session.hs +++ b/server/src-lib/Hasura/RQL/Types/Session.hs @@ -8,6 +8,7 @@ module Hasura.RQL.Types.Session mkSessionVariable, mkSessionVariablesText, isSessionVariable, + isSessionVariableCI, UserAdminSecret (..), BackendOnlyFieldAccess (..), UserInfo (..), @@ -44,13 +45,21 @@ sessionVariablePrefix :: Text sessionVariablePrefix = "x-hasura-" isSessionVariable :: Text -> Bool -isSessionVariable = T.isPrefixOf sessionVariablePrefix . T.toLower +{-# INLINE isSessionVariable #-} -- hope any redundant conversions vis a vis SessionVariable are eliminated +isSessionVariable = T.isPrefixOf sessionVariablePrefix . T.toCaseFold + +-- | A more efficient form of 'isSessionVariable', where applicable +isSessionVariableCI :: CI.CI Text -> Bool +{-# INLINE isSessionVariableCI #-} +isSessionVariableCI = T.isPrefixOf sessionVariablePrefix . CI.foldedCase parseSessionVariable :: Text -> Parser SessionVariable parseSessionVariable t = - if isSessionVariable t - then pure $ mkSessionVariable t - else fail $ show t <> " is not a Hasura session variable" + -- for performance we avoid isSessionVariable, doing just one case conversion + let sessionVar_dirty = mkSessionVariable t + in if sessionVariablePrefix `T.isPrefixOf` CI.foldedCase (unSessionVariable sessionVar_dirty) + then pure sessionVar_dirty + else fail $ show t <> " is not a Hasura session variable" instance FromJSON SessionVariable where parseJSON = withText "String" parseSessionVariable @@ -58,8 +67,9 @@ instance FromJSON SessionVariable where instance FromJSONKey SessionVariable where fromJSONKey = FromJSONKeyTextParser parseSessionVariable +-- | in normalized, lower-case form sessionVariableToText :: SessionVariable -> Text -sessionVariableToText = T.toLower . CI.original . unSessionVariable +sessionVariableToText = CI.foldedCase . unSessionVariable mkSessionVariable :: Text -> SessionVariable mkSessionVariable = SessionVariable . CI.mk diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index e3f2785690dba..83373b2fa4b72 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -1,4 +1,8 @@ {-# LANGUAGE TemplateHaskell #-} +-- TODO: +-- In the use of ‘unregisteredClaims’ (imported from Crypto.JWT): +-- Deprecated: "use a sub-type" +{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module : Hasura.Server.Auth.JWT @@ -101,7 +105,7 @@ import Hasura.Server.Utils import Hasura.Session (SessionVariable, SessionVariableValue, UserAdminSecret (..), UserInfo, UserRoleBuild (..), mkSessionVariable, mkSessionVariablesHeaders, mkSessionVariablesText, mkUserInfo, sessionVariableToText) import Network.HTTP.Client.Transformable qualified as HTTP import Network.HTTP.Types as N -import Network.URI (URI) +import Network.URI.Extended (URI) import Network.Wreq qualified as Wreq import Web.Spock.Internal.Cookies qualified as Spock diff --git a/server/src-lib/Hasura/Server/Auth/JWT/Internal.hs b/server/src-lib/Hasura/Server/Auth/JWT/Internal.hs index 06f9d2b8878c6..a1e69ec04b3f9 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT/Internal.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT/Internal.hs @@ -114,8 +114,9 @@ pubKeyToJwk pubKey = do return $ fromKeyMaterial $ OKPKeyMaterial (Ed25519Key pubKeyEd Nothing) X509.PubKeyEC pubKeyEc -> case ecParametersFromX509 pubKeyEc of - Nothing -> Left "Error getting EC parameters from the public key" - Just ecKeyParameters -> + -- TODO: do we want to log or expose this possibly sensitive Error?: + Left (_ :: Error) -> Left "Error getting EC parameters from the public key" + Right ecKeyParameters -> return $ fromKeyMaterial $ ECKeyMaterial ecKeyParameters _ -> Left "This key type is not supported" rsaKeyParams n e = diff --git a/server/src-lib/Hasura/Server/Init/Arg.hs b/server/src-lib/Hasura/Server/Init/Arg.hs index 7698a6a18cdb7..2767811f6f8f2 100644 --- a/server/src-lib/Hasura/Server/Init/Arg.hs +++ b/server/src-lib/Hasura/Server/Init/Arg.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ApplicativeDo #-} +{-# OPTIONS_GHC -Wno-deprecations #-} module Hasura.Server.Init.Arg ( -- * Main Opt.Parser 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 94857d9f591e7..828812c3ef978 100644 --- a/server/src-lib/Hasura/Server/Init/Arg/Command/Serve.hs +++ b/server/src-lib/Hasura/Server/Init/Arg/Command/Serve.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-deprecations #-} -- | The Arg Opt.Parser for the 'serve' subcommand. module Hasura.Server.Init.Arg.Command.Serve diff --git a/server/src-lib/Hasura/Server/Init/Arg/PrettyPrinter.hs b/server/src-lib/Hasura/Server/Init/Arg/PrettyPrinter.hs index f7697e6fdd23c..244499148156c 100644 --- a/server/src-lib/Hasura/Server/Init/Arg/PrettyPrinter.hs +++ b/server/src-lib/Hasura/Server/Init/Arg/PrettyPrinter.hs @@ -1,4 +1,6 @@ --- +-- TODO "Deprecated: "Compatibility module for users of ansi-wl-pprint - use "Prettyprinter" instead" " +{-# OPTIONS_GHC -Wno-deprecations #-} + module Hasura.Server.Init.Arg.PrettyPrinter ( (PP.<$>), PP.Doc, diff --git a/server/src-lib/Hasura/Server/ResourceChecker.hs b/server/src-lib/Hasura/Server/ResourceChecker.hs index 3bf677a74c30a..7902e36d09463 100644 --- a/server/src-lib/Hasura/Server/ResourceChecker.hs +++ b/server/src-lib/Hasura/Server/ResourceChecker.hs @@ -271,9 +271,9 @@ mergeCpuMemoryErrors cpuErr memErr = case (cpuErr, memErr) of (Just e1, Just e2) -> Just $ RCInternalError (show e1 <> "|" <> show e2) readFileT :: (MonadIO m, MonadError ResourceCheckerError m) => (String -> ResourceCheckerError) -> FilePath -> m T.Text -readFileT mapError path = do +readFileT mapErr path = do eContent <- liftIO $ catchIOError (Right <$> T.readFile path) (pure . Left . show) - liftEither $ mapLeft mapError eContent + liftEither $ mapLeft mapErr eContent parseUint :: (Integral a) => T.Text -> Either ResourceCheckerError a parseUint = bimap RCInternalError fst . T.decimal @@ -283,4 +283,4 @@ readFileUint :: (String -> ResourceCheckerError) -> FilePath -> m a -readFileUint mapError p = (liftEither . parseUint) =<< readFileT mapError p +readFileUint mapErr p = (liftEither . parseUint) =<< readFileT mapErr p diff --git a/server/src-lib/Hasura/Session.hs b/server/src-lib/Hasura/Session.hs index 4b7fb03837c4a..a9faa6a66f7c1 100644 --- a/server/src-lib/Hasura/Session.hs +++ b/server/src-lib/Hasura/Session.hs @@ -32,7 +32,7 @@ import Data.Text qualified as T import Hasura.Base.Error import Hasura.Prelude import Hasura.RQL.Types.Roles (RoleName, adminRoleName, mkRoleName, roleNameToTxt) -import Hasura.RQL.Types.Session (BackendOnlyFieldAccess (..), ExtraUserInfo (..), SessionVariable (..), SessionVariableValue, SessionVariables (..), UserInfo (..), UserInfoM (..), UserRoleBuild (..), mkSessionVariable, mkSessionVariablesText, sessionVariableToText) +import Hasura.RQL.Types.Session (BackendOnlyFieldAccess (..), ExtraUserInfo (..), SessionVariable (..), SessionVariableValue, SessionVariables (..), UserInfo (..), UserInfoM (..), UserRoleBuild (..), isSessionVariableCI, mkSessionVariable, mkSessionVariablesText, sessionVariableToText) import Hasura.Server.Utils import Language.GraphQL.Draft.Syntax qualified as G import Network.HTTP.Types qualified as HTTP @@ -55,9 +55,15 @@ mkSessionVariablesHeaders = SessionVariables . HashMap.fromList . map (first SessionVariable) - . filter (isSessionVariable . CI.original . fst) -- Only x-hasura-* headers + . filter (isSessionVariableCI . fst) -- Only x-hasura-* headers . map (CI.map bsToTxt *** bsToTxt) +---- Something like this a little faster, but I expect some test failures +-- . map (lowerToTxt *** bsToTxt) +-- where +-- -- NOTE: this throws away the original, vs 'CI.map bsToTxt' +-- lowerToTxt = CI.unsafeMk . bsToTxt . CI.foldedCase + sessionVariablesToHeaders :: SessionVariables -> [HTTP.Header] sessionVariablesToHeaders = map ((CI.map txtToBs . unSessionVariable) *** txtToBs) diff --git a/server/src-test/Control/Monad/MemoizeSpec.hs b/server/src-test/Control/Monad/MemoizeSpec.hs index e034fe417c332..bb9f398d8a8ef 100644 --- a/server/src-test/Control/Monad/MemoizeSpec.hs +++ b/server/src-test/Control/Monad/MemoizeSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-redundant-constraints #-} module Control.Monad.MemoizeSpec (spec) where diff --git a/server/src-test/Hasura/Server/AuthSpec.hs b/server/src-test/Hasura/Server/AuthSpec.hs index 036ab1779a572..7fa71d693b9e3 100644 --- a/server/src-test/Hasura/Server/AuthSpec.hs +++ b/server/src-test/Hasura/Server/AuthSpec.hs @@ -1,4 +1,8 @@ {-# LANGUAGE UndecidableInstances #-} +-- TODO: +-- In the use of ‘unregisteredClaims’ (imported from Crypto.JWT): +-- Deprecated: "use a sub-type" +{-# OPTIONS_GHC -Wno-deprecations #-} module Hasura.Server.AuthSpec (spec) where