Servant Client tests scaffolding

gargantext.cabal

@@ -62,6 +62,7 @@ library
       Gargantext.API.Node.File
       Gargantext.API.Node.Share
       Gargantext.API.Prelude
+      Gargantext.API.Routes
       Gargantext.Core
       Gargantext.Core.NLP
       Gargantext.Core.Methods.Similarities
@@ -190,7 +191,6 @@ library
       Gargantext.API.Node.Types
       Gargantext.API.Node.Update
       Gargantext.API.Public
-      Gargantext.API.Routes
       Gargantext.API.Search
       Gargantext.API.Server
       Gargantext.API.Swagger
@@ -885,7 +885,8 @@ test-suite garg-test-tasty
       Test.Core.Utils
       Test.Database.Operations
       Test.Database.Operations.DocumentSearch
-      Test.Database.Operations.Types
+      Test.Database.Setup
+      Test.Database.Types
       Test.Graph.Clustering
       Test.Graph.Distance
       Test.Ngrams.Lang
@@ -955,6 +956,7 @@ test-suite garg-test-tasty
     , raw-strings-qq
     , recover-rtti >= 0.4 && < 0.5
     , resource-pool >= 0.2.3.2 && < 0.2.4
+    , servant-client
     , servant-job
     , shelly >= 1.9 && < 2
     , stm ^>= 2.5.0.1
@@ -968,15 +970,19 @@ test-suite garg-test-tasty
     , tmp-postgres >= 1.34.1 && < 1.35
     , unordered-containers ^>= 0.2.16.0
     , validity ^>= 0.11.0.1
+    , warp
   default-language: Haskell2010
 
 test-suite garg-test-hspec
   type: exitcode-stdio-1.0
   main-is: drivers/hspec/Main.hs
   other-modules:
+      Test.API
+      Test.API.Authentication
       Test.Database.Operations
       Test.Database.Operations.DocumentSearch
-      Test.Database.Operations.Types
+      Test.Database.Setup
+      Test.Database.Types
       Paths_gargantext
   hs-source-dirs:
       test
@@ -1039,6 +1045,7 @@ test-suite garg-test-hspec
     , raw-strings-qq
     , recover-rtti >= 0.4 && < 0.5
     , resource-pool >= 0.2.3.2 && < 0.2.4
+    , servant-client
     , servant-job
     , shelly >= 1.9 && < 2
     , stm ^>= 2.5.0.1
@@ -1052,6 +1059,7 @@ test-suite garg-test-hspec
     , tmp-postgres >= 1.34.1 && < 1.35
     , unordered-containers ^>= 0.2.16.0
     , validity ^>= 0.11.0.1
+    , warp
   default-language: Haskell2010
 
 benchmark garg-bench

test/Test/API.hs

 
 module Test.API where
+
+import Prelude
+import Test.Hspec
+import qualified Test.API.Authentication as Auth
+
+tests :: Spec
+tests = describe "API" $
+  Auth.tests

test/Test/API/Authentication.hs

+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
-module API.Authentication where
+module Test.API.Authentication where
 
-tests :: TestTree
-tests = testGroup "Authentication" [unitTests]
+import Prelude
+import Control.Concurrent.MVar
+import Data.Proxy
+import Gargantext.API (makeApp)
+import Gargantext.API.Admin.EnvTypes (Mode(Mock))
+import Gargantext.API.Admin.Settings (newEnv)
+import Gargantext.API.Routes
+import Gargantext.System.Logging
+import Network.HTTP.Client hiding (Proxy)
+import Servant.Client
+import Test.Database.Setup (withTestDB, fakeIniPath)
+import Test.Hspec
+import qualified Network.Wai.Handler.Warp         as Warp
+import Test.Database.Types
+
+withGargApp :: (Warp.Port -> IO ()) -> IO ()
+withGargApp action = do
+  randomPort <- newEmptyMVar
+  let createApp = do
+        port <- readMVar randomPort
+        withLoggerHoisted Mock $ \ioLogger -> do
+          ini <- fakeIniPath
+          env <- newEnv ioLogger port ini
+          makeApp env
+  Warp.testWithApplication createApp (\p -> putMVar randomPort p >> action p)
+
+withTestDBAndPort :: ((TestEnv, Warp.Port) -> IO ()) -> IO ()
+withTestDBAndPort action =
+  withTestDB $ \testEnv ->
+    withGargApp $ \port ->
+      action (testEnv, port)
+
+tests :: Spec
+tests = sequential $ aroundAll withTestDBAndPort $ do
+  describe "Authentication" $ do
+    let getVersion = client (Proxy :: Proxy GargVersion)
+    baseUrl <- runIO $ parseBaseUrl "http://localhost"
+    manager <- runIO $ newManager defaultManagerSettings
+    let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })
+
+    -- testing scenarios start here
+    describe "GET /version" $ do
+      it "requires no auth" $ \(_testEnv, port) -> do
+        result <- runClientM getVersion (clientEnv port)
+        result `shouldBe` (Right "foo")

test/Test/Database/Operations.hs

@@ -2,18 +2,15 @@
 {-# LANGUAGE TupleSections        #-}
 {-# LANGUAGE TypeApplications     #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies         #-}
 {-# OPTIONS_GHC -Wno-orphans      #-}
-{-# LANGUAGE TypeFamilies #-}
 
 module Test.Database.Operations (
    tests
   ) where
 
-import Control.Exception hiding (assert)
 import Control.Monad.Except
 import Control.Monad.Reader
-import Data.Pool hiding (withResource)
-import Data.String
 import Database.PostgreSQL.Simple
 import Gargantext.API.Node.Corpus.Update
 import Gargantext.Core
@@ -26,23 +23,15 @@ import Gargantext.Database.Query.Table.Node (mk, getCorporaWithParentId, getOrMk
 import Gargantext.Database.Query.Tree.Root (getRootId)
 import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Prelude
-import Gargantext.Prelude.Config
 import Prelude
-import Shelly hiding (FilePath, run)
-import qualified Data.Pool as Pool
 import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import qualified Database.PostgreSQL.Simple as PG
-import qualified Database.PostgreSQL.Simple.Options as Client
-import qualified Database.Postgres.Temp as Tmp
-import qualified Shelly as SH
 
 import Gargantext.Database.Action.Flow
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Admin.Trigger.Init
-import Paths_gargantext
 import Test.Database.Operations.DocumentSearch
-import Test.Database.Operations.Types
+import Test.Database.Setup (withTestDB)
+import Test.Database.Types
 import Test.Hspec
 import Test.QuickCheck.Monadic
 import Test.Tasty.HUnit hiding (assert)
@@ -59,58 +48,6 @@ uniqueArbitraryNewUser currentIx = do
    ascii_txt :: Gen T.Text
    ascii_txt = fmap (T.pack . getPrintableString) arbitrary
 
--- | Test DB settings.
-dbUser, dbPassword, dbName :: String
-dbUser = "gargantua"
-dbPassword = "gargantua_test"
-dbName = "gargandb_test"
-
-fakeIniPath :: IO FilePath
-fakeIniPath = getDataFileName "test-data/test_config.ini"
-
-gargDBSchema :: IO FilePath
-gargDBSchema = getDataFileName "devops/postgres/schema.sql"
-
-teardown :: TestEnv -> IO ()
-teardown TestEnv{..} = do
-  destroyAllResources $ _DBHandle test_db
-  Tmp.stop $ _DBTmp test_db
-
--- | Bootstraps the DB, by creating the DB and the schema.
-bootstrapDB :: Tmp.DB -> Pool PG.Connection -> GargConfig -> IO ()
-bootstrapDB tmpDB pool _cfg = Pool.withResource pool $ \conn -> do
-  void $ PG.execute_ conn (fromString $ "ALTER USER \"" <> dbUser <> "\" with PASSWORD '" <> dbPassword <> "'")
-  schemaPath <- gargDBSchema
-  let connString = Tmp.toConnectionString tmpDB
-  (res,ec) <- shelly $ silently $ escaping False $ do
-    result <- SH.run "psql" ["-d", "\"" <> TE.decodeUtf8 connString <> "\"", "<", fromString schemaPath]
-    (result,) <$> lastExitCode
-  unless (ec == 0) $ throwIO (userError $ show ec <> ": " <> T.unpack res)
-
-tmpPgConfig :: Tmp.Config
-tmpPgConfig = Tmp.defaultConfig <>
-  Tmp.optionsToDefaultConfig mempty
-    { Client.dbname   = pure dbName
-    , Client.user     = pure dbUser
-    , Client.password = pure dbPassword
-    }
-
-setup :: IO TestEnv
-setup = do
-  res <- Tmp.startConfig tmpPgConfig
-  case res of
-    Left err -> fail $ show err
-    Right db -> do
-      gargConfig <- fakeIniPath >>= readConfig
-      pool <- createPool (PG.connectPostgreSQL (Tmp.toConnectionString db))
-                         (PG.close) 2 60 2
-      bootstrapDB db pool gargConfig
-      ugen <- emptyCounter
-      pure $ TestEnv (DBHandle pool db) gargConfig ugen
-
-withTestDB :: (TestEnv -> IO ()) -> IO ()
-withTestDB = bracket setup teardown
-
 tests :: Spec
 tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
   describe "Prelude" $ do

test/Test/Database/Operations/DocumentSearch.hs

@@ -18,7 +18,7 @@ import Gargantext.Database.Query.Tree.Root
 import Gargantext.Database.Schema.Node (NodePoly(..))
 import Network.URI (parseURI)
 
-import Test.Database.Operations.Types
+import Test.Database.Types
 import Test.Hspec.Expectations
 import Test.Tasty.HUnit
 import Gargantext.Core.Text.Terms.Mono.Stem.En

test/Test/Database/Setup.hs

+{-# LANGUAGE TupleSections #-}
+module Test.Database.Setup (
+  withTestDB
+  , fakeIniPath
+  ) where
+
+import Control.Exception hiding (assert)
+import Control.Monad
+import Data.Pool hiding (withResource)
+import Data.String
+import Gargantext.Prelude.Config
+import Paths_gargantext
+import Prelude
+import Shelly hiding (FilePath, run)
+import qualified Data.Pool as Pool
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Database.PostgreSQL.Simple as PG
+import qualified Database.PostgreSQL.Simple.Options as Client
+import qualified Database.Postgres.Temp as Tmp
+import qualified Shelly as SH
+
+import Test.Database.Types
+
+-- | Test DB settings.
+dbUser, dbPassword, dbName :: String
+dbUser = "gargantua"
+dbPassword = "gargantua_test"
+dbName = "gargandb_test"
+
+fakeIniPath :: IO FilePath
+fakeIniPath = getDataFileName "test-data/test_config.ini"
+
+gargDBSchema :: IO FilePath
+gargDBSchema = getDataFileName "devops/postgres/schema.sql"
+
+teardown :: TestEnv -> IO ()
+teardown TestEnv{..} = do
+  destroyAllResources $ _DBHandle test_db
+  Tmp.stop $ _DBTmp test_db
+
+-- | Bootstraps the DB, by creating the DB and the schema.
+bootstrapDB :: Tmp.DB -> Pool PG.Connection -> GargConfig -> IO ()
+bootstrapDB tmpDB pool _cfg = Pool.withResource pool $ \conn -> do
+  void $ PG.execute_ conn (fromString $ "ALTER USER \"" <> dbUser <> "\" with PASSWORD '" <> dbPassword <> "'")
+  schemaPath <- gargDBSchema
+  let connString = Tmp.toConnectionString tmpDB
+  (res,ec) <- shelly $ silently $ escaping False $ do
+    result <- SH.run "psql" ["-d", "\"" <> TE.decodeUtf8 connString <> "\"", "<", fromString schemaPath]
+    (result,) <$> lastExitCode
+  unless (ec == 0) $ throwIO (userError $ show ec <> ": " <> T.unpack res)
+
+tmpPgConfig :: Tmp.Config
+tmpPgConfig = Tmp.defaultConfig <>
+  Tmp.optionsToDefaultConfig mempty
+    { Client.dbname   = pure dbName
+    , Client.user     = pure dbUser
+    , Client.password = pure dbPassword
+    }
+
+setup :: IO TestEnv
+setup = do
+  res <- Tmp.startConfig tmpPgConfig
+  case res of
+    Left err -> fail $ show err
+    Right db -> do
+      gargConfig <- fakeIniPath >>= readConfig
+      pool <- createPool (PG.connectPostgreSQL (Tmp.toConnectionString db))
+                         (PG.close) 2 60 2
+      bootstrapDB db pool gargConfig
+      ugen <- emptyCounter
+      pure $ TestEnv (DBHandle pool db) gargConfig ugen
+
+withTestDB :: (TestEnv -> IO ()) -> IO ()
+withTestDB = bracket setup teardown

test/Test/Database/Operations/Types.hs → test/Test/Database/Types.hs

@@ -2,7 +2,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans      #-}
 
-module Test.Database.Operations.Types where
+module Test.Database.Types where
 
 import Control.Exception
 import Control.Lens

test/drivers/hspec/Main.hs

@@ -5,8 +5,9 @@ import Gargantext.Prelude
 
 import Control.Exception
 import Shelly hiding (FilePath)
-import System.Process
 import System.IO
+import System.Process
+import qualified Test.API                     as API
 import qualified Test.Database.Operations     as DB
 
 import Test.Hspec
@@ -40,4 +41,6 @@ stopCoreNLPServer = interruptProcessGroupOf
 main :: IO ()
 main = do
   hSetBuffering stdout NoBuffering
-  bracket startCoreNLPServer stopCoreNLPServer (const (hspec DB.tests))
+  bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ do
+    DB.tests
+    API.tests