[refactor] fix tests for new Gargantext.Prelude

parent b3d75db5
Pipeline #5256 failed with stages
in 13 minutes and 45 seconds
...@@ -167,4 +167,3 @@ package hmatrix ...@@ -167,4 +167,3 @@ package hmatrix
package sparse-linear package sparse-linear
ghc-options: -O2 -fsimpl-tick-factor=10000 -fdicts-cheap -fdicts-strict -flate-dmd-anal -fno-state-hack ghc-options: -O2 -fsimpl-tick-factor=10000 -fdicts-cheap -fdicts-strict -flate-dmd-anal -fno-state-hack
...@@ -8,24 +8,22 @@ module Test.API.Authentication ( ...@@ -8,24 +8,22 @@ module Test.API.Authentication (
, auth_api , auth_api
) where ) where
import Prelude import Control.Lens
import Data.Proxy import Data.Proxy
import Gargantext.API.Routes import Data.Text as T
import Network.HTTP.Client hiding (Proxy)
import Servant.Client
import Test.Hspec
import Test.Database.Types
import Servant.Auth.Client ()
import Gargantext.API.Admin.Auth.Types import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Routes
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Control.Monad
import Control.Monad.Reader
import Gargantext.Database.Action.User.New import Gargantext.Database.Action.User.New
import Gargantext.Core.Types import Gargantext.Prelude
import Network.HTTP.Client hiding (Proxy)
import Prelude qualified
import Servant.Auth.Client ()
import Servant.Client
import Test.API.Setup (withTestDBAndPort, setupEnvironment) import Test.API.Setup (withTestDBAndPort, setupEnvironment)
import qualified Data.Text as T import Test.Database.Types
import Control.Lens import Test.Hspec
import Data.Maybe
auth_api :: AuthRequest -> ClientM AuthResponse auth_api :: AuthRequest -> ClientM AuthResponse
auth_api = client (Proxy :: Proxy (MkGargAPI (GargAPIVersion AuthAPI))) auth_api = client (Proxy :: Proxy (MkGargAPI (GargAPIVersion AuthAPI)))
...@@ -48,7 +46,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -48,7 +46,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "requires no auth and returns the current version" $ \((_testEnv, port), _) -> do it "requires no auth and returns the current version" $ \((_testEnv, port), _) -> do
result <- runClientM version_api (clientEnv port) result <- runClientM version_api (clientEnv port)
case result of case result of
Left err -> fail (show err) Left err -> Prelude.fail (show err)
Right r -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back Right r -> r `shouldSatisfy` ((>= 1) . T.length) -- we got something back
describe "POST /api/v1.0/auth" $ do describe "POST /api/v1.0/auth" $ do
......
...@@ -12,21 +12,20 @@ module Test.API.Private ( ...@@ -12,21 +12,20 @@ module Test.API.Private (
, protected , protected
) where ) where
import Control.Exception import Data.ByteString.Lazy qualified as L
import Control.Monad import Data.Text.Encoding qualified as TE
import Control.Monad.Reader
import Data.ByteString (ByteString)
import Data.Maybe
import Data.Proxy
import Gargantext.API.Admin.Auth.Types import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Routes import Gargantext.API.Routes
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Prelude hiding (get)
import Network.HTTP.Client hiding (Proxy) import Network.HTTP.Client hiding (Proxy)
import Network.HTTP.Types import Network.HTTP.Types
import Network.Wai.Handler.Warp qualified as Wai
import Network.Wai.Test (SResponse) import Network.Wai.Test (SResponse)
import Prelude import Prelude qualified
import Servant import Servant
import Servant.Auth.Client () import Servant.Auth.Client ()
import Servant.Auth.Client qualified as SA
import Servant.Client import Servant.Client
import Test.API.Authentication (auth_api) import Test.API.Authentication (auth_api)
import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, mkUrl, createAliceAndBob)
...@@ -34,10 +33,6 @@ import Test.Hspec ...@@ -34,10 +33,6 @@ import Test.Hspec
import Test.Hspec.Wai hiding (pendingWith) import Test.Hspec.Wai hiding (pendingWith)
import Test.Hspec.Wai.Internal (withApplication) import Test.Hspec.Wai.Internal (withApplication)
import Test.Utils (jsonFragment, shouldRespondWith') import Test.Utils (jsonFragment, shouldRespondWith')
import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Encoding as TE
import qualified Network.Wai.Handler.Warp as Wai
import qualified Servant.Auth.Client as SA
-- | Issue a request with a valid 'Authorization: Bearer' inside. -- | Issue a request with a valid 'Authorization: Bearer' inside.
protected :: Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse protected :: Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse
...@@ -59,12 +54,12 @@ withValidLogin port ur pwd act = do ...@@ -59,12 +54,12 @@ withValidLogin port ur pwd act = do
let authPayload = AuthRequest ur pwd let authPayload = AuthRequest ur pwd
result <- liftIO $ runClientM (auth_api authPayload) clientEnv result <- liftIO $ runClientM (auth_api authPayload) clientEnv
case result of case result of
Left err -> liftIO $ throwIO $ userError (show err) Left err -> liftIO $ throwIO $ Prelude.userError (show err)
Right res Right res
| Just tkn <- _authRes_valid res | Just tkn <- _authRes_valid res
-> act (_authVal_token tkn) -> act (_authVal_token tkn)
| otherwise | otherwise
-> fail $ "No token found in " <> show res -> Prelude.fail $ "No token found in " <> show res
tests :: Spec tests :: Spec
......
...@@ -5,13 +5,9 @@ module Test.Database.Setup ( ...@@ -5,13 +5,9 @@ module Test.Database.Setup (
, testEnvToPgConnectionInfo , testEnvToPgConnectionInfo
) where ) where
import Control.Exception hiding (assert)
import Control.Monad
import Data.Maybe (fromMaybe)
import Data.Monoid
import Data.Pool hiding (withResource) import Data.Pool hiding (withResource)
import Data.Pool qualified as Pool import Data.Pool qualified as Pool
import Data.String import Data.String (fromString)
import Data.Text qualified as T import Data.Text qualified as T
import Data.Text.Encoding qualified as TE import Data.Text.Encoding qualified as TE
import Database.PostgreSQL.Simple qualified as PG import Database.PostgreSQL.Simple qualified as PG
...@@ -19,16 +15,17 @@ import Database.PostgreSQL.Simple.Options qualified as Client ...@@ -19,16 +15,17 @@ import Database.PostgreSQL.Simple.Options qualified as Client
import Database.PostgreSQL.Simple.Options qualified as Opts import Database.PostgreSQL.Simple.Options qualified as Opts
import Database.Postgres.Temp qualified as Tmp import Database.Postgres.Temp qualified as Tmp
import Gargantext.API.Admin.EnvTypes (Mode(Mock)) import Gargantext.API.Admin.EnvTypes (Mode(Mock))
import Gargantext.Prelude
import Gargantext.Prelude.Config import Gargantext.Prelude.Config
import Gargantext.System.Logging (withLoggerHoisted) import Gargantext.System.Logging (withLoggerHoisted)
import Paths_gargantext import Paths_gargantext
import Prelude import Prelude qualified
import Shelly hiding (FilePath, run) import Shelly hiding (FilePath, run)
import Shelly qualified as SH import Shelly qualified as SH
import Test.Database.Types import Test.Database.Types
-- | Test DB settings. -- | Test DB settings.
dbUser, dbPassword, dbName :: String dbUser, dbPassword, dbName :: Prelude.String
dbUser = "gargantua" dbUser = "gargantua"
dbPassword = "gargantua_test" dbPassword = "gargantua_test"
dbName = "gargandb_test" dbName = "gargandb_test"
...@@ -53,7 +50,7 @@ bootstrapDB tmpDB pool _cfg = Pool.withResource pool $ \conn -> do ...@@ -53,7 +50,7 @@ bootstrapDB tmpDB pool _cfg = Pool.withResource pool $ \conn -> do
(res,ec) <- shelly $ silently $ escaping False $ do (res,ec) <- shelly $ silently $ escaping False $ do
result <- SH.run "psql" ["-d", "\"" <> TE.decodeUtf8 connString <> "\"", "<", fromString schemaPath] result <- SH.run "psql" ["-d", "\"" <> TE.decodeUtf8 connString <> "\"", "<", fromString schemaPath]
(result,) <$> lastExitCode (result,) <$> lastExitCode
unless (ec == 0) $ throwIO (userError $ show ec <> ": " <> T.unpack res) unless (ec == 0) $ throwIO (Prelude.userError $ show ec <> ": " <> T.unpack res)
tmpPgConfig :: Tmp.Config tmpPgConfig :: Tmp.Config
tmpPgConfig = Tmp.defaultConfig <> tmpPgConfig = Tmp.defaultConfig <>
...@@ -67,7 +64,7 @@ setup :: IO TestEnv ...@@ -67,7 +64,7 @@ setup :: IO TestEnv
setup = do setup = do
res <- Tmp.startConfig tmpPgConfig res <- Tmp.startConfig tmpPgConfig
case res of case res of
Left err -> fail $ show err Left err -> Prelude.fail $ show err
Right db -> do Right db -> do
gargConfig <- fakeIniPath >>= readConfig gargConfig <- fakeIniPath >>= readConfig
pool <- createPool (PG.connectPostgreSQL (Tmp.toConnectionString db)) pool <- createPool (PG.connectPostgreSQL (Tmp.toConnectionString db))
......
{-|
Module : Test.Utils.Jobs
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE NumericUnderscores #-}
module Test.Utils.Jobs (test) where module Test.Utils.Jobs (test) where
import Control.Concurrent import Control.Concurrent
import qualified Control.Concurrent.Async as Async import Control.Concurrent.Async
import Control.Concurrent.Async qualified as Async
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Exception import Data.Sequence ((|>), fromList)
import Control.Monad import Data.Text (isInfixOf)
import Control.Monad.Reader
import Control.Monad.Except
import Data.Maybe
import Data.Either
import Data.List
import Data.Sequence (Seq, (|>), fromList)
import Data.Time import Data.Time
import Debug.RecoverRTTI (anythingToString) import Debug.RecoverRTTI (anythingToString)
import Prelude import Gargantext.API.Admin.EnvTypes as EnvTypes
import System.IO.Unsafe import Gargantext.API.Admin.Orchestrator.Types
import Network.HTTP.Client.TLS (newTlsManager) import Gargantext.API.Prelude
import Network.HTTP.Client (Manager) import Gargantext.Prelude
import Test.Hspec
import Test.Hspec.Expectations.Contrib (annotate)
import qualified Servant.Job.Types as SJ
import qualified Servant.Job.Core as SJ
import Gargantext.Utils.Jobs.Internal (newJob) import Gargantext.Utils.Jobs.Internal (newJob)
import Gargantext.Utils.Jobs.Map import Gargantext.Utils.Jobs.Map
import Gargantext.Utils.Jobs.Monad hiding (withJob) import Gargantext.Utils.Jobs.Monad hiding (withJob)
import Gargantext.Utils.Jobs.Queue (applyPrios, defaultPrios) import Gargantext.Utils.Jobs.Queue (applyPrios, defaultPrios)
import Gargantext.Utils.Jobs.State import Gargantext.Utils.Jobs.State
import Gargantext.API.Prelude import Network.HTTP.Client (Manager)
import Gargantext.API.Admin.EnvTypes as EnvTypes import Network.HTTP.Client.TLS (newTlsManager)
import Gargantext.API.Admin.Orchestrator.Types import Prelude qualified
import Control.Concurrent.Async import Servant.Job.Core qualified as SJ
import Servant.Job.Types qualified as SJ
import System.IO.Unsafe
import Test.Hspec
import Test.Hspec.Expectations.Contrib (annotate)
data JobT = A data JobT = A
...@@ -71,7 +76,7 @@ waitTimerSTM tv = do ...@@ -71,7 +76,7 @@ waitTimerSTM tv = do
-- | Samples the running jobs from the first 'TVar' and write them -- | Samples the running jobs from the first 'TVar' and write them
-- in the queue. -- in the queue.
sampleRunningJobs :: Timer -> TVar [String] -> TQueue [String]-> STM () sampleRunningJobs :: Timer -> TVar [Prelude.String] -> TQueue [Prelude.String]-> STM ()
sampleRunningJobs timer runningJs samples = do sampleRunningJobs timer runningJs samples = do
waitTimerSTM timer waitTimerSTM timer
runningNow <- readTVar runningJs runningNow <- readTVar runningJs
...@@ -87,7 +92,7 @@ testMaxRunners = do ...@@ -87,7 +92,7 @@ testMaxRunners = do
let num_jobs = 4 let num_jobs = 4
k <- genSecret k <- genSecret
let settings = defaultJobSettings 2 k let settings = defaultJobSettings 2 k
st :: JobsState JobT [String] () <- newJobsState settings defaultPrios st :: JobsState JobT [Prelude.String] () <- newJobsState settings defaultPrios
now <- getCurrentTime now <- getCurrentTime
runningJs <- newTVarIO [] runningJs <- newTVarIO []
samples <- newTQueueIO samples <- newTQueueIO
...@@ -143,7 +148,7 @@ testPrios = do ...@@ -143,7 +148,7 @@ testPrios = do
-- without worrying about the runners competing with each other. -- without worrying about the runners competing with each other.
let settings = defaultJobSettings 1 k let settings = defaultJobSettings 1 k
prios = [(B, 10), (C, 1), (D, 5)] prios = [(B, 10), (C, 1), (D, 5)]
st :: JobsState JobT [String] () <- newJobsState settings $ st :: JobsState JobT [Prelude.String] () <- newJobsState settings $
applyPrios prios defaultPrios -- B has the highest priority applyPrios prios defaultPrios -- B has the highest priority
pickedSchedule <- newMVar (JobSchedule mempty) pickedSchedule <- newMVar (JobSchedule mempty)
let j jobt _jHandle _inp _l = addJobToSchedule jobt pickedSchedule let j jobt _jHandle _inp _l = addJobToSchedule jobt pickedSchedule
...@@ -168,7 +173,7 @@ testExceptions :: IO () ...@@ -168,7 +173,7 @@ testExceptions :: IO ()
testExceptions = do testExceptions = do
k <- genSecret k <- genSecret
let settings = defaultJobSettings 1 k let settings = defaultJobSettings 1 k
st :: JobsState JobT [String] () <- newJobsState settings defaultPrios st :: JobsState JobT [Prelude.String] () <- newJobsState settings defaultPrios
jid <- pushJob A () jid <- pushJob A ()
(\_jHandle _inp _log -> readFile "/doesntexist.txt" >>= putStrLn) (\_jHandle _inp _log -> readFile "/doesntexist.txt" >>= putStrLn)
settings st settings st
...@@ -176,17 +181,17 @@ testExceptions = do ...@@ -176,17 +181,17 @@ testExceptions = do
threadDelay $ 1_000_000 threadDelay $ 1_000_000
mjob <- lookupJob jid (jobsData st) mjob <- lookupJob jid (jobsData st)
case mjob of case mjob of
Nothing -> fail "lookupJob failed, job not found!" Nothing -> Prelude.fail "lookupJob failed, job not found!"
Just je -> case jTask je of Just je -> case jTask je of
DoneJ _ r -> isLeft r `shouldBe` True DoneJ _ r -> isLeft r `shouldBe` True
unexpected -> fail $ "Expected job to be done, but got: " <> anythingToString unexpected unexpected -> Prelude.fail $ "Expected job to be done, but got: " <> anythingToString unexpected
return () return ()
testFairness :: IO () testFairness :: IO ()
testFairness = do testFairness = do
k <- genSecret k <- genSecret
let settings = defaultJobSettings 1 k let settings = defaultJobSettings 1 k
st :: JobsState JobT [String] () <- newJobsState settings defaultPrios st :: JobsState JobT [Prelude.String] () <- newJobsState settings defaultPrios
pickedSchedule <- newMVar (JobSchedule mempty) pickedSchedule <- newMVar (JobSchedule mempty)
let j jobt _jHandle _inp _l = addJobToSchedule jobt pickedSchedule let j jobt _jHandle _inp _l = addJobToSchedule jobt pickedSchedule
jobs = [ (A, j A) jobs = [ (A, j A)
...@@ -260,17 +265,17 @@ newTestEnv = do ...@@ -260,17 +265,17 @@ newTestEnv = do
let settings = defaultJobSettings 1 k let settings = defaultJobSettings 1 k
myEnv <- newJobEnv settings defaultPrios testTlsManager myEnv <- newJobEnv settings defaultPrios testTlsManager
pure $ Env pure $ Env
{ _env_settings = error "env_settings not needed, but forced somewhere (check StrictData)" { _env_settings = Prelude.error "env_settings not needed, but forced somewhere (check StrictData)"
, _env_logger = error "env_logger not needed, but forced somewhere (check StrictData)" , _env_logger = Prelude.error "env_logger not needed, but forced somewhere (check StrictData)"
, _env_pool = error "env_pool not needed, but forced somewhere (check StrictData)" , _env_pool = Prelude.error "env_pool not needed, but forced somewhere (check StrictData)"
, _env_nodeStory = error "env_nodeStory not needed, but forced somewhere (check StrictData)" , _env_nodeStory = Prelude.error "env_nodeStory not needed, but forced somewhere (check StrictData)"
, _env_manager = testTlsManager , _env_manager = testTlsManager
, _env_self_url = error "self_url not needed, but forced somewhere (check StrictData)" , _env_self_url = Prelude.error "self_url not needed, but forced somewhere (check StrictData)"
, _env_scrapers = error "scrapers not needed, but forced somewhere (check StrictData)" , _env_scrapers = Prelude.error "scrapers not needed, but forced somewhere (check StrictData)"
, _env_jobs = myEnv , _env_jobs = myEnv
, _env_config = error "config not needed, but forced somewhere (check StrictData)" , _env_config = Prelude.error "config not needed, but forced somewhere (check StrictData)"
, _env_mail = error "mail not needed, but forced somewhere (check StrictData)" , _env_mail = Prelude.error "mail not needed, but forced somewhere (check StrictData)"
, _env_nlp = error "nlp not needed, but forced somewhere (check StrictData)" , _env_nlp = Prelude.error "nlp not needed, but forced somewhere (check StrictData)"
} }
testFetchJobStatus :: IO () testFetchJobStatus :: IO ()
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment