ihp-hspec (empty) → 1.5.0

raw patch · 4 files changed

+182/−0 lines, 4 filesdep +basedep +hasqldep +ihp

Dependencies added: base, hasql, ihp, ihp-ide, ihp-log, process, text, uuid, vault, wai, wai-request-params

Files

IHP/Hspec.hs +109/−0
LICENSE +21/−0
changelog.md +11/−0
ihp-hspec.cabal +41/−0

+ IHP/Hspec.hs view

@@ -0,0 +1,109 @@+module IHP.Hspec (withIHPApp) where++import IHP.Prelude+import qualified Hasql.Connection as Hasql+import qualified Hasql.Connection.Settings as HasqlSettings+import qualified Hasql.Session as Session+import qualified Hasql.Statement as Statement+import qualified Hasql.Decoders as Decoders+import qualified Hasql.Encoders as Encoders+import qualified Data.UUID.V4 as UUID+import qualified Data.UUID as UUID+import qualified Data.Text as Text+import qualified Control.Exception as Exception+import IHP.IDE.CodeGen.MigrationGenerator (findIHPSchemaSql)++import Network.Wai+import Network.Wai.Internal (ResponseReceived (..))++import IHP.ControllerSupport (InitControllerContext)+import IHP.FrameworkConfig (ConfigBuilder (..), FrameworkConfig (..))+import qualified IHP.FrameworkConfig as FrameworkConfig+import qualified IHP.ModelSupport as ModelSupport+import IHP.Log.Types++import qualified System.Process as Process+import IHP.Test.Mocking (MockContext(..), runTestMiddlewares)+import qualified IHP.PGListener as PGListener++withConnection :: ByteString -> (Hasql.Connection -> IO a) -> IO a+withConnection databaseUrl action = do+    connResult <- Hasql.acquire (HasqlSettings.connectionString (cs databaseUrl))+    case connResult of+        Right conn -> action conn `Exception.finally` Hasql.release conn+        Left err -> error (show err)++runSessionOnConnection :: Hasql.Connection -> Session.Session a -> IO ()+runSessionOnConnection conn session = do+    result <- Hasql.use conn session+    case result of+        Left err -> error (show err)+        Right _ -> pure ()++-- | Create contexts that can be used for mocking+withIHPApp :: (InitControllerContext application) => application -> ConfigBuilder -> (MockContext application -> IO ()) -> IO ()+withIHPApp application configBuilder hspecAction = do+    FrameworkConfig.withFrameworkConfig configBuilder \frameworkConfig -> do+        logger <- newLogger def { level = Warn } -- don't log queries++        withTestDatabase frameworkConfig.databaseUrl \testDatabaseUrl -> do+            ModelSupport.withModelContext testDatabaseUrl logger \modelContext -> do+                PGListener.withPGListener testDatabaseUrl logger \pgListener' -> do+                    let baseRequest = defaultRequest+                    let pgListener = Just pgListener'+                    mockRequest <- runTestMiddlewares frameworkConfig modelContext pgListener baseRequest+                    let mockRespond = const (pure ResponseReceived)++                    hspecAction MockContext { .. }++withTestDatabase :: ByteString -> (ByteString -> IO ()) -> IO ()+withTestDatabase masterDatabaseUrl callback = do+    testDatabaseName <- randomDatabaseName++    withConnection masterDatabaseUrl \masterConnection ->+        Exception.bracket_+            (runSessionOnConnection masterConnection (execDDL ("CREATE DATABASE " <> quoteIdentifier testDatabaseName)))+            (+                -- The WITH FORCE is required to force close open connections+                runSessionOnConnection masterConnection (execDDL ("DROP DATABASE " <> quoteIdentifier testDatabaseName <> " WITH (FORCE)"))+            )+            do+                let testDatabaseUrl = injectDatabaseName testDatabaseName masterDatabaseUrl+                importSql testDatabaseUrl+                callback testDatabaseUrl+    pure ()++-- | Execute a DDL statement (CREATE DATABASE, DROP DATABASE, etc.)+execDDL :: Text -> Session.Session ()+execDDL sql = Session.statement () (Statement.unpreparable (cs sql) Encoders.noParams Decoders.noResult)++-- | Quote a SQL identifier (e.g., database name) with double quotes+quoteIdentifier :: Text -> Text+quoteIdentifier name = "\"" <> Text.replace "\"" "\"\"" name <> "\""++-- | Imports the IHP Schema.sql and Application/Schema.sql+importSql :: ByteString -> IO ()+importSql databaseUrl = do+    -- Import IHP Schema+    ihpSchemaSql <- findIHPSchemaSql+    Process.callCommand ("psql " <> cs databaseUrl <> " < " <> cs (osPathToText ihpSchemaSql))++    -- Import Application Schema+    Process.callCommand ("psql " <> cs databaseUrl <> " < Application/Schema.sql")++    -- Import Application Fixtures (if any)+    Process.callCommand ("psql " <> cs databaseUrl <> " < Application/Fixtures.sql")++randomDatabaseName :: IO Text+randomDatabaseName = do+    uuid <- UUID.nextRandom+    let name = "test_db_" <> (uuid |> UUID.toText |> Text.replace "-" "_")+    pure name++injectDatabaseName :: Text -> ByteString -> ByteString+injectDatabaseName databaseName databaseUrl =+        databaseUrl+        |> cs+        -- Remove database name from url so we can connect to the default database+        |> Text.replace "/app" ("/" <> databaseName)+        |> cs

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 digitally induced GmbH++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ changelog.md view

@@ -0,0 +1,11 @@+# Changelog for `ihp-hspec`++## v1.5.0++- Migrate from postgresql-simple to hasql+- Run full middleware stack for each test request+- Add bracket-style `withModelContext`++## v1.4.0++- Initial release as a standalone package

+ ihp-hspec.cabal view

@@ -0,0 +1,41 @@+cabal-version:       2.2+name:                ihp-hspec+version:             1.5.0+synopsis:            Test helpers for IHP apps+description:         Provides the withIHPApp function for hspec tests+license:             MIT+license-file:        LICENSE+author:              digitally induced GmbH+maintainer:          support@digitallyinduced.com+homepage:            https://ihp.digitallyinduced.com/+bug-reports:         https://github.com/digitallyinduced/ihp/issues+copyright:           (c) digitally induced GmbH+category:            Testing+build-type:          Simple+extra-source-files:  changelog.md++source-repository head+    type:     git+    location: https://github.com/digitallyinduced/ihp++library+    default-language: GHC2021+    default-extensions:+        NoImplicitPrelude+        OverloadedLabels+        OverloadedRecordDot+        DuplicateRecordFields+        DisambiguateRecordFields+        TypeApplications+        TemplateHaskell+        QuasiQuotes+        PackageImports+        ScopedTypeVariables+        BlockArguments+        OverloadedStrings+        ImplicitParams+        RecordWildCards+    ghc-options: -Werror=incomplete-patterns -Werror=unused-imports -Werror=missing-fields+    build-depends: base >= 4.17.0 && < 4.22, ihp, ihp-log, wai, process, text, ihp-ide, vault, uuid, hasql, wai-request-params+    hs-source-dirs: .+    exposed-modules: IHP.Hspec