Add a test of tests in common via persistent #2872

Dupe of https://github.com/hasura/graphql-engine-mono/pull/2872 with branch renamed so it doesn't break a tool. prev pr: https://github.com/hasura/graphql-engine-mono/pull/2921 PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2922 Co-authored-by: Abby Sassel <3883855+sassela@users.noreply.github.com> GitOrigin-RevId: 24af6a814dd106864a2fd3cb985edfe9a8ef5d61
2024-09-11 10:46:25 +03:00 · 2021-11-26 18:21:01 +00:00 · 2021-11-26 18:21:01 +00:00 · 12335bce91
commit 12335bce91
parent 4f6831d76e
6 changed files with 122 additions and 49 deletions
--- a/cabal.project.freeze
+++ b/cabal.project.freeze
@ -1,5 +1,6 @@
 active-repositories: hackage.haskell.org:merge
 constraints: any.Cabal ==3.2.0.0,
+             Cabal -bundled-binary-generic,
             any.HTTP ==4000.3.15,
             HTTP -conduit10 -mtl1 +network-uri -warn-as-error -warp-tests,
             any.HUnit ==1.6.2.0,
@ -15,9 +16,9 @@ constraints: any.Cabal ==3.2.0.0,
             any.aeson ==1.5.5.1,
             aeson -bytestring-builder -cffi -developer -fast,
             any.aeson-casing ==0.2.0.0,
-             any.aeson-qq ==0.8.3,
             any.aeson-pretty ==0.8.8,
             aeson-pretty -lib-only,
+             any.aeson-qq ==0.8.3,
             any.ansi-terminal ==0.11,
             ansi-terminal -example,
             any.ansi-wl-pprint ==0.6.9,
@ -215,8 +216,6 @@ constraints: any.Cabal ==3.2.0.0,
             lens -benchmark-uniplate -dump-splices +inlining -j -old-inline-pragmas -safe +test-doctests +test-hunit +test-properties +test-templates +trustworthy,
             any.lens-aeson ==1.1,
             lens-aeson +test-doctests,
-             any.megaparsec ==9.0.1,
-             megaparsec -dev,
             any.libyaml ==0.1.2,
             libyaml -no-unicode -system-libyaml,
             any.lifted-async ==0.10.1.2,
@ -226,11 +225,15 @@ constraints: any.Cabal ==3.2.0.0,
             any.logict ==0.7.0.3,
             any.math-functions ==0.3.4.1,
             math-functions +system-erf +system-expm1,
+             any.megaparsec ==9.0.1,
+             megaparsec -dev,
             any.memory ==0.15.0,
             memory +support_basement +support_bytestring +support_deepseq +support_foundation,
             any.mime-types ==0.1.0.9,
             any.mmorph ==1.1.4,
             any.monad-control ==1.0.2.3,
+             any.monad-logger ==0.3.36,
+             monad-logger +template_haskell,
             any.monad-loops ==0.4.3,
             monad-loops +base4,
             any.monad-time ==0.3.1.0,
@ -241,7 +244,6 @@ constraints: any.Cabal ==3.2.0.0,
             mtl-compat -two-point-one -two-point-two,
             any.mustache ==2.3.1,
             any.mwc-random ==0.14.0.0,
-             any.raw-strings-qq ==1.1,
             any.mysql ==0.2.0.1,
             mysql -developer,
             any.mysql-simple ==0.4.6,
@ -265,12 +267,19 @@ constraints: any.Cabal ==3.2.0.0,
             any.optparse-generic ==1.4.4,
             any.parallel ==3.2.2.0,
             any.parsec ==3.1.14.0,
-             any.parsers ==0.12.10,
             any.parser-combinators ==1.3.0,
+             parser-combinators -dev,
+             any.parsers ==0.12.10,
             parsers +attoparsec +binary +parsec,
+             any.path-pieces ==0.2.1,
             any.pcre-light ==0.4.1.0,
             pcre-light -old_base -use-pkg-config,
             any.pem ==0.2.4,
+             any.persistent ==2.10.5.2,
+             persistent -nooverlap,
+             any.persistent-mysql ==2.10.2.3,
+             any.persistent-postgresql ==2.10.1.2,
+             any.persistent-template ==2.8.2.3,
             any.pg-client ==0.1.0,
             any.placeholders ==0.1,
             any.pointed ==5.0.2,
@ -328,6 +337,7 @@ constraints: any.Cabal ==3.2.0.0,
             any.setenv ==0.1.1.3,
             any.shakespeare ==2.0.25,
             shakespeare -test_coffee -test_export -test_roy,
+             any.silently ==1.2.5.1,
             any.simple-sendfile ==0.2.30,
             simple-sendfile +allow-bsd,
             any.smallcheck ==1.2.1,
@ -343,6 +353,7 @@ constraints: any.Cabal ==3.2.0.0,
             any.splitmix ==0.1.0.3,
             splitmix -optimised-mixer,
             any.stm ==2.5.0.1,
+             any.stm-chans ==3.0.0.4,
             any.stm-containers ==1.2,
             any.stm-hamt ==1.2.0.4,
             any.streaming-commons ==0.2.2.1,
@ -366,6 +377,7 @@ constraints: any.Cabal ==3.2.0.0,
             any.terminal-size ==0.3.2.1,
             any.terminfo ==0.4.1.4,
             any.text ==1.2.3.2,
+             text -developer -integer-simple,
             any.text-builder ==0.6.6.1,
             any.text-conversions ==0.3.1,
             any.text-latin1 ==0.3.1,
@ -404,10 +416,12 @@ constraints: any.Cabal ==3.2.0.0,
             any.unix-compat ==0.5.3,
             unix-compat -old-time,
             any.unix-time ==0.4.7,
+             any.unliftio ==0.2.18,
             any.unliftio-core ==0.2.0.1,
             any.unordered-containers ==0.2.13.0,
             unordered-containers -debug,
             any.uri-bytestring ==0.3.3.1,
+             uri-bytestring -lib-werror,
             any.uri-encode ==1.5.0.7,
             uri-encode +network-uri -tools,
             any.url ==2.1.3,
@ -448,4 +462,4 @@ constraints: any.Cabal ==3.2.0.0,
             any.zlib ==0.6.2.2,
             zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
             any.zlib-bindings ==0.1.1.5
-index-state: 2021-07-09T20:23:17Z
+index-state: hackage.haskell.org 2021-07-09T20:23:17Z
--- a/server/graphql-engine.cabal
+++ b/server/graphql-engine.cabal
@ -907,6 +907,12 @@ test-suite tests-hspec
    , th-lift
    , yaml
    , postgresql-simple
+    , persistent
+    , persistent-mysql
+    , persistent-postgresql
+    , persistent-template
+    , monad-logger
+    , unliftio-core
  hs-source-dirs: tests-hspec
  -- Turning off optimizations is intentional; tests aren't
  -- performance sensitive and waiting for compilation is a problem.
--- a/server/tests-hspec/BasicFieldsSpec.hs
+++ b/server/tests-hspec/BasicFieldsSpec.hs
@ -1,10 +1,20 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE UndecidableInstances #-}

 -- | Test querying an entity for a couple fields.
 module BasicFieldsSpec (spec) where

-import Harness.Constants
+import Control.Monad.IO.Unlift
+import Control.Monad.Reader
+import Data.Int
+import Data.Text (Text)
+import Database.Persist
+import Database.Persist.MySQL qualified as Mysql
+import Database.Persist.Postgresql qualified as Postgresql
+import Database.Persist.Sql
+import Database.Persist.TH
+import Harness.Constants as Constants
 import Harness.Feature qualified as Feature
 import Harness.Graphql
 import Harness.GraphqlEngine qualified as GraphqlEngine
@ -16,6 +26,33 @@ import Harness.Yaml
 import Test.Hspec
 import Prelude

+--------------------------------------------------------------------------------
+-- Schema
+
+share
+  [mkPersist sqlSettings, mkMigrate "migrateAll"]
+  [persistLowerCase|
+Author
+    Id Int32
+    name Text
+    deriving Eq
+    deriving Show
+|]
+
+--------------------------------------------------------------------------------
+-- Data setup
+
+setupDatabase :: (MonadIO m) => ReaderT SqlBackend m ()
+setupDatabase = do
+  void $
+    insertKey
+      (AuthorKey {unAuthorKey = 1} :: AuthorId)
+      Author {authorName = "Author 1"}
+  void $
+    insertKey
+      AuthorKey {unAuthorKey = 2}
+      Author {authorName = "Author 2"}
+
 --------------------------------------------------------------------------------
 -- Preamble

@ -64,23 +101,10 @@ args:
      pool_settings: {}
 |]

-  -- Setup tables
-  Mysql.run_
-    [sql|
-CREATE TABLE hasura.author
-(
-    id INT UNSIGNED NOT NULL AUTO_INCREMENT PRIMARY KEY,
-    name VARCHAR(45) UNIQUE KEY
-);
-|]
-  Mysql.run_
-    [sql|
-INSERT INTO hasura.author
-    (name)
-VALUES
-    ( 'Author 1'),
-    ( 'Author 2');
-|]
+  -- Setup database
+  Mysql.runPersistent do
+    Mysql.runMigration migrateAll
+    setupDatabase

  -- Track the tables
  GraphqlEngine.post_
@ -125,23 +149,10 @@ args:
        pool_settings: {}
 |]

-  -- Setup tables
-  Postgres.run_
-    [sql|
-CREATE TABLE hasura.author
-(
-    id SERIAL PRIMARY KEY,
-    name VARCHAR(45) UNIQUE
-);
-|]
-  Postgres.run_
-    [sql|
-INSERT INTO hasura.author
-    (name)
-VALUES
-    ( 'Author 1'),
-    ( 'Author 2');
-|]
+  -- Setup database
+  Postgres.runPersistent do
+    Postgresql.runMigration migrateAll
+    setupDatabase

  -- Track the tables
  GraphqlEngine.post_
--- a/server/tests-hspec/Harness/Constants.hs
+++ b/server/tests-hspec/Harness/Constants.hs
@ -24,6 +24,7 @@ module Harness.Constants
    httpHealthCheckIntervalSeconds,
    httpHealthCheckIntervalMicroseconds,
    serveOptions,
+    debugMessagesEnabled,
  )
 where

@ -144,10 +145,9 @@ serveOptions =
      soEnableAllowlist = False,
      soEnabledLogTypes = Set.empty,
      soLogLevel =
-        -- Use the below to show messages:
-        -- L.LevelDebug
-        -- Use the below to hide messages:
-        L.LevelOther "test-suite",
+        if debugMessagesEnabled
+          then L.LevelDebug
+          else L.LevelOther "test-suite",
      soResponseInternalErrorsConfig = InternalErrorsAllRequests,
      soEventsHttpPoolSize = Nothing,
      soEventsFetchInterval = Nothing,
@ -167,6 +167,10 @@ serveOptions =
      soWebsocketConnectionInitTimeout = defaultWSConnectionInitTimeout
    }

+-- | Use the below to show messages.
+debugMessagesEnabled :: Bool
+debugMessagesEnabled = False
+
 -- These are important for the test suite.
 testSuiteEnabledApis :: HashSet API
 testSuiteEnabledApis = Set.fromList [METADATA, GRAPHQL, DEVELOPER, CONFIG]
--- a/server/tests-hspec/Harness/Mysql.hs
+++ b/server/tests-hspec/Harness/Mysql.hs
@ -4,16 +4,21 @@
 module Harness.Mysql
  ( livenessCheck,
    run_,
+    runPersistent,
  )
 where

 import Control.Concurrent
 import Control.Exception
-import Data.Functor
+import Control.Monad.IO.Unlift
+import Control.Monad.Logger
+import Control.Monad.Reader
 import Data.String
 import Database.MySQL.Simple as Mysql
+import Database.Persist.MySQL qualified as Mysql
+import Database.Persist.Sql
 import GHC.Stack
-import Harness.Constants qualified as Constants
+import Harness.Constants as Constants
 import System.Process.Typed
 import Prelude

@ -55,3 +60,19 @@ run_ query' =
              ]
          )
    )
+
+-- | Run a persistent action against mysql.
+runPersistent ::
+  (MonadUnliftIO m, HasCallStack) =>
+  ReaderT SqlBackend (NoLoggingT m) a ->
+  m a
+runPersistent actions =
+  runNoLoggingT
+    ( Mysql.withMySQLConn
+        Constants.mysqlConnectInfo
+        ( \conn -> do
+            a <- runReaderT actions conn
+            liftIO $ connCommit conn (error "Invalid use of connCommit.")
+            pure a
+        )
+    )
--- a/server/tests-hspec/Harness/Postgres.hs
+++ b/server/tests-hspec/Harness/Postgres.hs
@ -4,18 +4,23 @@
 module Harness.Postgres
  ( livenessCheck,
    run_,
+    runPersistent,
  )
 where

 import Control.Concurrent
 import Control.Exception
+import Control.Monad.IO.Unlift
+import Control.Monad.Logger
+import Control.Monad.Reader
 import Data.ByteString.Char8 qualified as S8
-import Data.Functor
 import Data.String
+import Database.Persist.Postgresql qualified as Postgresql
+import Database.Persist.Sql
 import Database.PostgreSQL.LibPQ qualified as PQ
 import Database.PostgreSQL.Simple qualified as Postgres
 import GHC.Stack
-import Harness.Constants qualified as Constants
+import Harness.Constants as Constants
 import System.Process.Typed
 import Prelude

@ -59,3 +64,15 @@ run_ q =
              ]
          )
    )
+
+-- | Run persistent for postgres.
+runPersistent ::
+  (MonadUnliftIO m, HasCallStack) =>
+  ReaderT SqlBackend (NoLoggingT m) a ->
+  m a
+runPersistent actions =
+  runNoLoggingT
+    ( Postgresql.withPostgresqlConn
+        (fromString Constants.postgresqlConnectionString)
+        (runReaderT actions)
+    )