src/Gargantext/API/Node/Corpus/New.hs

   1 {-|
   2 Module      : Gargantext.API.Node.Corpus.New
   3 Description : New corpus API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 New corpus means either:
  11 - new corpus
  12 - new data in existing corpus
  13 -}
  14
  15 {-# LANGUAGE TemplateHaskell    #-}
  16 {-# LANGUAGE TypeOperators      #-}
  17
  18 module Gargantext.API.Node.Corpus.New
  19       where
  20
  21 import Control.Lens hiding (elements, Empty)
  22 import Data.Aeson
  23 import Data.Aeson.TH (deriveJSON)
  24 import Data.Either
  25 import Data.Maybe (fromMaybe)
  26 import Data.Swagger
  27 import Data.Text (Text)
  28 import qualified Data.Text as T
  29 import GHC.Generics (Generic)
  30 import Servant
  31 import Servant.Job.Utils (jsonOptions)
  32 -- import Servant.Multipart
  33 -- import Test.QuickCheck (elements)
  34 import Test.QuickCheck.Arbitrary
  35
  36 import Gargantext.Prelude
  37
  38 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs, jobLogSucc)
  39 import Gargantext.API.Admin.Types (HasSettings)
  40 import Gargantext.API.Node.Corpus.New.File
  41 import Gargantext.API.Node.Corpus.Searx
  42 import Gargantext.API.Node.Corpus.Types
  43 import Gargantext.API.Node.Types
  44 import Gargantext.Core (Lang(..){-, allLangs-})
  45 import qualified Gargantext.Core.Text.Corpus.API as API
  46 import qualified Gargantext.Core.Text.Corpus.Parsers as Parser (FileFormat(..), parseFormat)
  47 import Gargantext.Core.Types.Individu (User(..))
  48 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
  49 import Gargantext.Database.Action.Flow (FlowCmdM, flowCorpus, getDataText, flowDataText, TermType(..){-, allDataOrigins-})
  50 import Gargantext.Database.Action.Mail (sendMail)
  51 import Gargantext.Database.Action.Node (mkNodeWithParent)
  52 import Gargantext.Database.Action.User (getUserId)
  53 import Gargantext.Database.Admin.Types.Hyperdata
  54 import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), UserId)
  55 import Gargantext.Database.Query.Table.Node (getNodeWith)
  56 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
  57 import Gargantext.Database.Schema.Node (node_hyperdata)
  58 import qualified Gargantext.Database.GargDB as GargDB
  59
  60 ------------------------------------------------------------------------
  61 {-
  62 data Query = Query { query_query      :: Text
  63                    , query_node_id    :: Int
  64                    , query_lang       :: Lang
  65                    , query_databases  :: [DataOrigin]
  66                    }
  67                    deriving (Eq, Generic)
  68
  69 deriveJSON (unPrefix "query_") 'Query
  70
  71 instance Arbitrary Query where
  72     arbitrary = elements [ Query q n la fs
  73                          | q <- ["honeybee* AND collapse"
  74                                 ,"covid 19"
  75                                 ]
  76                          , n <- [0..10]
  77                          , la <- allLangs
  78                          , fs <- take 3 $ repeat allDataOrigins
  79                          ]
  80
  81 instance ToSchema Query where
  82   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
  83 -}
  84
  85 ------------------------------------------------------------------------
  86
  87 {-
  88 type Api = PostApi
  89         :<|> GetApi
  90
  91 type PostApi = Summary "New Corpus endpoint"
  92              :> ReqBody '[JSON] Query
  93              :> Post    '[JSON] CorpusId
  94 type GetApi = Get '[JSON] ApiInfo
  95 -}
  96
  97 -- | TODO manage several apis
  98 -- TODO-ACCESS
  99 -- TODO this is only the POST
 100 {-
 101 api :: (FlowCmdM env err m) => UserId -> Query -> m CorpusId
 102 api uid (Query q _ as) = do
 103   cId <- case head as of
 104     Nothing      -> flowCorpusSearchInDatabase (UserDBId uid) EN q
 105     Just API.All -> flowCorpusSearchInDatabase (UserDBId uid) EN q
 106     Just a   -> do
 107       docs <- liftBase $ API.get a q (Just 1000)
 108       cId' <- flowCorpus (UserDBId uid) (Left q) (Multi EN) [docs]
 109       pure cId'
 110
 111   pure cId
 112 -}
 113
 114 ------------------------------------------------
 115 -- TODO use this route for Client implementation
 116 data ApiInfo = ApiInfo { api_info :: [API.ExternalAPIs]}
 117   deriving (Generic)
 118 instance Arbitrary ApiInfo where
 119   arbitrary = ApiInfo <$> arbitrary
 120
 121 deriveJSON (unPrefix "") 'ApiInfo
 122
 123 instance ToSchema ApiInfo
 124
 125 info :: FlowCmdM env err m => UserId -> m ApiInfo
 126 info _u = pure $ ApiInfo API.externalAPIs
 127
 128 ------------------------------------------------------------------------
 129 ------------------------------------------------------------------------
 130 data WithQuery = WithQuery
 131   { _wq_query     :: !Text
 132   , _wq_databases :: !Database
 133   , _wq_datafield :: !Datafield
 134   , _wq_lang      :: !Lang
 135   , _wq_node_id   :: !Int
 136   }
 137   deriving Generic
 138
 139 makeLenses ''WithQuery
 140 instance FromJSON WithQuery where
 141   parseJSON = genericParseJSON $ jsonOptions "_wq_"
 142 instance ToJSON WithQuery where
 143   toJSON = genericToJSON $ jsonOptions "_wq_"
 144 instance ToSchema WithQuery where
 145   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_")
 146
 147 ------------------------------------------------------------------------
 148
 149 type AddWithQuery = Summary "Add with Query to corpus endpoint"
 150    :> "corpus"
 151      :> Capture "corpus_id" CorpusId
 152    :> "query"
 153      :> AsyncJobs JobLog '[JSON] WithQuery JobLog
 154
 155 {-
 156 type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
 157    :> "corpus"
 158      :> Capture "corpus_id" CorpusId
 159    :> "add"
 160    :> "file"
 161      :> MultipartForm Mem (MultipartData Mem)
 162      :> QueryParam "fileType"  FileType
 163    :> "async"
 164      :> AsyncJobs JobLog '[JSON] () JobLog
 165 -}
 166
 167
 168 ------------------------------------------------------------------------
 169 -- TODO WithQuery also has a corpus id
 170 addToCorpusWithQuery :: FlowCmdM env err m
 171                        => User
 172                        -> CorpusId
 173                        -> WithQuery
 174                        -> Maybe Integer
 175                        -> (JobLog -> m ())
 176                        -> m JobLog
 177 addToCorpusWithQuery user cid (WithQuery q dbs datafield l _nid) maybeLimit logStatus = do
 178   -- TODO ...
 179   logStatus JobLog { _scst_succeeded = Just 0
 180                    , _scst_failed    = Just 0
 181                    , _scst_remaining = Just 3
 182                    , _scst_events    = Just []
 183                    }
 184   printDebug "[addToCorpusWithQuery] (cid, dbs)" (cid, dbs)
 185   printDebug "[addToCorpusWithQuery] datafield" datafield
 186
 187   case datafield of
 188     Web -> do
 189       printDebug "[addToCorpusWithQuery] processing web request" datafield
 190
 191       _ <- triggerSearxSearch cid q l
 192
 193       pure JobLog { _scst_succeeded = Just 3
 194                   , _scst_failed    = Just 0
 195                   , _scst_remaining = Just 0
 196                   , _scst_events    = Just []
 197                   }
 198
 199     _ -> do
 200       -- TODO add cid
 201       -- TODO if cid is folder -> create Corpus
 202       --      if cid is corpus -> add to corpus
 203       --      if cid is root   -> create corpus in Private
 204       txts <- mapM (\db  -> getDataText db (Multi l) q maybeLimit) [database2origin dbs]
 205
 206       logStatus JobLog { _scst_succeeded = Just 2
 207                        , _scst_failed    = Just 0
 208                        , _scst_remaining = Just 1
 209                        , _scst_events    = Just []
 210                        }
 211
 212       cids <- mapM (\txt -> flowDataText user txt (Multi l) cid) txts
 213       printDebug "corpus id" cids
 214       printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
 215       sendMail user
 216       -- TODO ...
 217       pure JobLog { _scst_succeeded = Just 3
 218                   , _scst_failed    = Just 0
 219                   , _scst_remaining = Just 0
 220                   , _scst_events    = Just []
 221                   }
 222
 223
 224 type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
 225    :> "corpus"
 226      :> Capture "corpus_id" CorpusId
 227    :> "add"
 228    :> "form"
 229    :> "async"
 230      :> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
 231
 232 addToCorpusWithForm :: FlowCmdM env err m
 233                     => User
 234                     -> CorpusId
 235                     -> NewWithForm
 236                     -> (JobLog -> m ())
 237                     -> JobLog
 238                     -> m JobLog
 239 addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus jobLog = do
 240   printDebug "[addToCorpusWithForm] Parsing corpus: " cid
 241   printDebug "[addToCorpusWithForm] fileType" ft
 242   logStatus jobLog
 243   let
 244     parse = case ft of
 245       CSV_HAL   -> Parser.parseFormat Parser.CsvHal
 246       CSV       -> Parser.parseFormat Parser.CsvGargV3
 247       WOS       -> Parser.parseFormat Parser.WOS
 248       PresseRIS -> Parser.parseFormat Parser.RisPresse
 249
 250   -- TODO granularity of the logStatus
 251   docs <- liftBase $ splitEvery 500
 252       <$> take 1000000
 253       <$> parse (cs d)
 254
 255   printDebug "Parsing corpus finished : " cid
 256   logStatus jobLog2
 257
 258   printDebug "Starting extraction     : " cid
 259   -- TODO granularity of the logStatus
 260   _cid' <- flowCorpus user
 261                      (Right [cid])
 262                      (Multi $ fromMaybe EN l)
 263                      (map (map toHyperdataDocument) docs)
 264
 265   printDebug "Extraction finished   : " cid
 266   printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
 267   sendMail user
 268
 269   pure jobLog3
 270     where
 271       jobLog2 = jobLogSucc jobLog
 272       jobLog3 = jobLogSucc jobLog2
 273
 274 {-
 275 addToCorpusWithFile :: FlowCmdM env err m
 276                     => CorpusId
 277                     -> MultipartData Mem
 278                     -> Maybe FileType
 279                     -> (JobLog -> m ())
 280                     -> m JobLog
 281 addToCorpusWithFile cid input filetype logStatus = do
 282   logStatus JobLog { _scst_succeeded = Just 10
 283                           , _scst_failed    = Just 2
 284                           , _scst_remaining = Just 138
 285                           , _scst_events    = Just []
 286                           }
 287   printDebug "addToCorpusWithFile" cid
 288   _h <- postUpload cid filetype input
 289
 290   pure      JobLog { _scst_succeeded = Just 137
 291                           , _scst_failed    = Just 13
 292                           , _scst_remaining = Just 0
 293                           , _scst_events    = Just []
 294                           }
 295 -}
 296
 297
 298
 299 type AddWithFile = Summary "Add with FileUrlEncoded to corpus endpoint"
 300    :> "corpus"
 301      :> Capture "corpus_id" CorpusId
 302    :> "add"
 303    :> "file"
 304    :> "async"
 305      :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
 306
 307 addToCorpusWithFile :: (HasSettings env, FlowCmdM env err m)
 308                     => User
 309                     -> CorpusId
 310                     -> NewWithFile
 311                     -> (JobLog -> m ())
 312                     -> m JobLog
 313 addToCorpusWithFile user cid nwf@(NewWithFile _d _l fName) logStatus = do
 314
 315   printDebug "[addToCorpusWithFile] Uploading file to corpus: " cid
 316   logStatus JobLog { _scst_succeeded = Just 0
 317                    , _scst_failed    = Just 0
 318                    , _scst_remaining = Just 1
 319                    , _scst_events    = Just []
 320                    }
 321
 322   fPath <- GargDB.writeFile nwf
 323   printDebug "[addToCorpusWithFile] File saved as: " fPath
 324
 325   uId <- getUserId user
 326   nIds <- mkNodeWithParent NodeFile (Just cid) uId fName
 327
 328   _ <- case nIds of
 329     [nId] -> do
 330         node <- getNodeWith nId (Proxy :: Proxy HyperdataFile)
 331         let hl = node ^. node_hyperdata
 332         _ <- updateHyperdata nId $ hl { _hff_name = fName
 333                                       , _hff_path = T.pack fPath }
 334
 335         printDebug "[addToCorpusWithFile] Created node with id: " nId
 336     _     -> pure ()
 337
 338   printDebug "[addToCorpusWithFile] File upload to corpus finished: " cid
 339
 340   printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
 341   sendMail user
 342
 343   pure $ JobLog { _scst_succeeded = Just 1
 344                 , _scst_failed    = Just 0
 345                 , _scst_remaining = Just 0
 346                 , _scst_events    = Just []
 347                 }