{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.API.Export (tests) where import Data.ByteString.Lazy qualified as BSL import Data.Version (showVersion) import Database.SQLite.Simple qualified as S -- import Fmt (build) import Gargantext.API.Node.Corpus.Export.Types (CorpusSQLite(..), CorpusSQLiteData(..)) import Gargantext.API.Node.Corpus.Export.Utils (withTempSQLiteDir, mkCorpusSQLiteData) import Gargantext.Core (Lang(EN)) import Gargantext.Core.Text.Terms (TermType(Multi)) import Gargantext.Core.Types (unNodeId) import Gargantext.Core.Types.Individu import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus) import Gargantext.Database.Action.User (getUserId) import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus) import Gargantext.Database.Admin.Types.Node (NodeType(NodeFolder, NodeCorpus, NodeFolderPrivate)) import Gargantext.Database.Prelude import Gargantext.Database.Query.Table.Node (getOrMkList, getNodeWith, insertDefaultNode, insertNode) import Gargantext.Database.Query.Tree.Root (getRootId) import Gargantext.Database.Schema.Node (node_hyperdata) import Gargantext.Prelude hiding (get) import Paths_gargantext qualified as PG -- cabal magic build module import Servant.API.ResponseHeaders (Headers(getResponse)) import Servant.Auth.Client () import Servant.Client.Streaming (runClientM) import Test.API.Prelude (checkEither) import Test.API.Routes (get_corpus_sqlite_export) import Test.API.Setup (withTestDBAndPort, dbEnvSetup, SpecContext (..)) import Test.API.UpdateList (createFortranDocsList) import Test.Database.Operations.DocumentSearch (exampleDocument_01, exampleDocument_02) import Test.Database.Types (runTestMonad) import Test.Hspec import Test.Hspec.Wai.Internal (withApplication) import Test.Utils (withValidLogin) tests :: Spec tests = sequential $ around withTestDBAndPort $ beforeWith dbEnvSetup $ do describe "Export API" $ do describe "Check CorpusSQLiteData creation" $ do it "correctly creates CorpusSQLiteData" $ \ctx -> do runTestMonad (_sctx_env ctx) $ do aliceUserId <- runDBQuery $ getUserId (UserName "alice") aliceRootId <- runDBQuery $ getRootId (UserName "alice") alicePrivateFolderId <- runDBTx $ insertNode NodeFolderPrivate (Just "NodeFolderPrivate") Nothing aliceRootId aliceUserId aliceFolderId <- runDBTx $ insertDefaultNode NodeFolder alicePrivateFolderId aliceUserId corpusId <- runDBTx $ insertDefaultNode NodeCorpus aliceFolderId aliceUserId aliceListId <- runDBTx $ getOrMkList corpusId aliceUserId corpus <- runDBQuery $ getNodeWith corpusId (Proxy @HyperdataCorpus) let docs = [ exampleDocument_01, exampleDocument_02 ] let lang = EN _ <- addDocumentsToHyperCorpus (Just $ corpus ^. node_hyperdata) (Multi lang) corpusId docs (CorpusSQLiteData { .. }) <- mkCorpusSQLiteData corpusId Nothing liftIO $ do _csd_version `shouldBe` PG.version _csd_cId `shouldBe` corpusId _csd_lId `shouldBe` aliceListId length _csd_contexts `shouldBe` 2 length _csd_map_context_ngrams `shouldBe` 0 length _csd_stop_context_ngrams `shouldBe` 0 length _csd_candidate_context_ngrams `shouldBe` 0 describe "GET /api/v1.0/corpus/cId/sqlite" $ do it "returns correct SQLite db" $ \ctx -> do let port = _sctx_port ctx withApplication (_sctx_app ctx) $ do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do cId <- createFortranDocsList (_sctx_env ctx) port clientEnv token void $ liftIO $ do (CorpusSQLite { _cs_bs }) <- (checkEither $ runClientM (get_corpus_sqlite_export token cId) clientEnv) >>= (pure . getResponse) withTempSQLiteDir $ \(_fp, _fname, fpath) -> do BSL.writeFile fpath _cs_bs S.withConnection fpath $ \conn -> do [S.Only cId'] <- S.query_ conn "SELECT value FROM info WHERE key = 'corpusId'" cId' `shouldBe` unNodeId cId -- [S.Only lId'] <- S.query_ conn "SELECT value FROM info WHERE key = 'listId'" -- lId' `shouldBe` unNodeId listId [S.Only version] <- S.query_ conn "SELECT value FROM info WHERE key = 'gargVersion'" version `shouldBe` showVersion PG.version [S.Only corpoLen] <- S.query conn "SELECT COUNT(*) FROM corpus WHERE id = ?" (S.Only $ unNodeId cId) corpoLen `shouldBe` (1 :: Int) -- [S.Only listLen] <- S.query conn "SELECT COUNT(*) FROM lists WHERE id = ?" (S.Only $ unNodeId listId) -- listLen `shouldBe` (1 :: Int) [S.Only ngramsLen] <- S.query_ conn "SELECT COUNT(*) FROM ngrams" ngramsLen `shouldBe` (0 :: Int) [S.Only docsLen] <- S.query_ conn "SELECT COUNT(*) FROM documents" docsLen `shouldBe` (2 :: Int)