Merge remote-tracking branch 'origin/571-dev-node-corpus-api-search-fixes' into dev-merge

src/Gargantext/API/Admin/Orchestrator/Types.hs

@@ -6,6 +6,7 @@ module Gargantext.API.Admin.Orchestrator.Types
   where
 
 import Control.Lens hiding (elements)
+import Control.Monad.Reader (MonadReader)
 import Data.Aeson
 import Data.Morpheus.Types
   ( GQLType
@@ -23,7 +24,9 @@ import Test.QuickCheck.Arbitrary
 
 import qualified Gargantext.API.GraphQL.Utils as GQLU
 import Gargantext.Core.Types (TODO(..))
+import Gargantext.Database.Prelude (HasConfig(..))
 import Gargantext.Prelude
+import Gargantext.Prelude.Config (gc_pubmed_api_key)
 
 ------------------------------------------------------------------------
 instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where
@@ -34,24 +37,39 @@ instance Arbitrary a => Arbitrary (JobOutput a) where
 
 -- | Main Types
 -- TODO IsidoreAuth
-data ExternalAPIs = PubMed
+data ExternalAPIs = All
+                  | PubMed { mAPIKey :: Maybe Text }
                   | Arxiv
                   | HAL
                   | IsTex
                   | Isidore
-  deriving (Show, Eq, Generic, Enum, Bounded)
+  deriving (Show, Eq, Generic)
 
 
 -- | Main Instances
 instance FromJSON ExternalAPIs
 instance ToJSON ExternalAPIs
 
-externalAPIs :: [ExternalAPIs]
-externalAPIs = [minBound .. maxBound]
+externalAPIs :: ( MonadReader env m
+                , HasConfig env) => m [ExternalAPIs]
+externalAPIs = do
+  pubmed_api_key <- view $ hasConfig . gc_pubmed_api_key
+
+  pure [ All
+       , PubMed { mAPIKey = Just pubmed_api_key }
+       , Arxiv
+       , HAL
+       , IsTex
+       , Isidore ]
 
 instance Arbitrary ExternalAPIs
   where
-    arbitrary = arbitraryBoundedEnum
+    arbitrary = elements [ All
+                         , PubMed { mAPIKey = Nothing }
+                         , Arxiv
+                         , HAL
+                         , IsTex
+                         , Isidore ]
 
 instance ToSchema ExternalAPIs where
   declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions

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

@@ -54,13 +54,13 @@ import Gargantext.Database.Action.Mail (sendMail)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Types.Hyperdata
-import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..))
+import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..), UserId)
 import Gargantext.Database.Prelude (hasConfig)
 import Gargantext.Database.Query.Table.Node (getNodeWith, updateCorpusPubmedAPIKey)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (gc_max_docs_parsers, gc_pubmed_api_key)
+import Gargantext.Prelude.Config (gc_max_docs_parsers)
 import Gargantext.Utils.Jobs (JobHandle, MonadJobStatus(..))
 import qualified Gargantext.Core.Text.Corpus.API as API
 import qualified Gargantext.Core.Text.Corpus.Parsers as Parser (FileType(..), parseFormatC)
@@ -131,8 +131,11 @@ deriveJSON (unPrefix "") 'ApiInfo
 
 instance ToSchema ApiInfo
 
-info :: ApiInfo
-info = ApiInfo API.externalAPIs
+info :: FlowCmdM env err m => UserId -> m ApiInfo
+info _u = do
+  ext <- API.externalAPIs
+
+  pure $ ApiInfo ext
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
@@ -216,8 +219,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
 
     _ -> do
       case datafield of
-         Just (External PubMed) -> do
-           _api_key <- view $ hasConfig . gc_pubmed_api_key
+         Just (External (PubMed { _api_key })) -> do
            printDebug "[addToCorpusWithQuery] pubmed api key" _api_key
            _ <- updateCorpusPubmedAPIKey cid _api_key
            pure ()
@@ -229,7 +231,7 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
       --      if cid is corpus -> add to corpus
       --      if cid is root   -> create corpus in Private
       -- printDebug "[G.A.N.C.New] getDataText with query" q
-      let db = database2origin dbs
+      db   <- database2origin dbs
       eTxt <- getDataText db (Multi l) q maybeLimit
 
       -- printDebug "[G.A.N.C.New] lTxts" lTxts

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

@@ -3,43 +3,55 @@
 module Gargantext.API.Node.Corpus.Types where
 
 import Control.Lens hiding (elements, Empty)
-import Control.Monad.Fail (fail)
+import Control.Monad.Reader (MonadReader)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
 import Data.Monoid (mempty)
 import Data.Swagger
 import GHC.Generics (Generic)
 import Test.QuickCheck
-import qualified Data.Text as T
+import qualified PUBMED.Types as PUBMED
 
 import Gargantext.Prelude
 
 import qualified Gargantext.API.Admin.Orchestrator.Types as Types
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Action.Flow (DataOrigin(..))
+import Gargantext.Database.Prelude (HasConfig(..))
 
 data Database = Empty
-              | PubMed
+              | PubMed { _api_key :: Maybe PUBMED.APIKey }
               | Arxiv
               | HAL
               | IsTex
               | Isidore
-  deriving (Eq, Show, Generic, Enum, Bounded)
+  deriving (Eq, Show, Generic)
+
+instance Arbitrary Database
+  where
+    arbitrary = elements [ Empty
+                         , PubMed { _api_key = Nothing }
+                         , Arxiv
+                         , HAL
+                         , IsTex
+                         , Isidore ]
 
-instance Arbitrary Database where
-  arbitrary = arbitraryBoundedEnum
 
 deriveJSON (unPrefix "") ''Database
 instance ToSchema Database where
   declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
 
-database2origin :: Database -> DataOrigin
-database2origin Empty   = InternalOrigin Types.IsTex
-database2origin PubMed  = ExternalOrigin Types.PubMed
-database2origin Arxiv   = ExternalOrigin Types.Arxiv
-database2origin HAL     = ExternalOrigin Types.HAL
-database2origin IsTex   = ExternalOrigin Types.IsTex
-database2origin Isidore = ExternalOrigin Types.Isidore
+database2origin :: ( MonadReader env m
+                   , HasConfig env ) => Database -> m DataOrigin
+database2origin Empty   = pure $ InternalOrigin Types.IsTex
+database2origin (PubMed { _api_key }) = do
+  -- pubmed_api_key <- view $ hasConfig . gc_pubmed_api_key
+
+  pure $ ExternalOrigin $ Types.PubMed { mAPIKey = _api_key }
+database2origin Arxiv   = pure $ ExternalOrigin Types.Arxiv
+database2origin HAL     = pure $ ExternalOrigin Types.HAL
+database2origin IsTex   = pure $ ExternalOrigin Types.IsTex
+database2origin Isidore = pure $ ExternalOrigin Types.Isidore
 
 ------------------------------------------------------------------------
 data Datafield = Gargantext
@@ -48,23 +60,25 @@ data Datafield = Gargantext
                | Files
   deriving (Eq, Show, Generic)
 
-instance FromJSON Datafield where
-  parseJSON = withText "Datafield" $ \text ->
-    case text of
-      "Gargantext"
-        -> pure Gargantext
-      "Web"
-        -> pure Web
-      "Files"
-        -> pure Files
-      v -> case T.breakOnEnd " " v of
-          ("External ", dbName)
-            -> External <$> parseJSON (String dbName)
-          _ -> fail $ "Cannot match patterh 'External <db>' for string " <> T.unpack v
+instance FromJSON Datafield
+instance ToJSON Datafield
+-- instance FromJSON Datafield where
+--   parseJSON = withText "Datafield" $ \text ->
+--     case text of
+--       "Gargantext"
+--         -> pure Gargantext
+--       "Web"
+--         -> pure Web
+--       "Files"
+--         -> pure Files
+--       v -> case T.breakOnEnd " " v of
+--           ("External ", dbName)
+--             -> External <$> parseJSON (String dbName)
+--           _ -> fail $ "Cannot match patterh 'External <db>' for string " <> T.unpack v
 
-instance ToJSON Datafield where
-  toJSON (External db) = toJSON $ "External " <> show db
-  toJSON s = toJSON $ show s
+-- instance ToJSON Datafield where
+--   toJSON (External db) = toJSON $ "External " <> show db
+--   toJSON s = toJSON $ show s
 
 instance Arbitrary Datafield where
   arbitrary = oneof [pure Gargantext, pure Web, pure Files, External <$> arbitrary]

src/Gargantext/API/Prelude.hs

@@ -48,6 +48,7 @@ import qualified Gargantext.Utils.Jobs.Monad as Jobs
 import Servant
 import Servant.Job.Async
 import Servant.Job.Core (HasServerError(..), serverError)
+import qualified Servant.Job.Types as SJ
 
 class HasJoseError e where
   _JoseError :: Prism' e Jose.Error
@@ -120,6 +121,15 @@ data GargError
 makePrisms ''GargError
 
 instance ToJSON GargError where
+  toJSON (GargJobError s) =
+    object [ ("status", toJSON SJ.IsFailure)
+           , ("log", emptyArray)
+           , ("id", String id)
+           , ("error", String $ Text.pack $ show s) ]
+    where
+      id = case s of
+        Jobs.InvalidMacID i -> i
+        _ -> ""
   toJSON err = object [("error", String $ Text.pack $ show err)]
 
 instance Exception GargError

src/Gargantext/API/Server.hs

@@ -18,7 +18,7 @@ import Control.Lens ((^.))
 import Control.Monad.Except (withExceptT)
 import Control.Monad.Reader (runReaderT)
 import qualified Data.Aeson as Aeson
-import Data.Text (Text, pack)
+import Data.Text (Text)
 import Data.Version (showVersion)
 import Servant
 import Servant.Swagger.UI (swaggerSchemaUIServer)
@@ -95,4 +95,4 @@ showAsServantJSONErr (GargNodeError err@NoCorpusFound) = err404 { errBody = Aeso
 showAsServantJSONErr (GargNodeError err@NoUserFound) = err404 { errBody = Aeson.encode err }
 showAsServantJSONErr (GargNodeError err@(DoesNotExist {})) = err404 { errBody = Aeson.encode err }
 showAsServantJSONErr (GargServerError err) = err
-showAsServantJSONErr a = err500 { errBody = Aeson.encode $ Aeson.object [ ( "error", Aeson.String $ pack $ show a ) ] }
+showAsServantJSONErr a = err500 { errBody = Aeson.encode a }

src/Gargantext/Core/Text/Corpus/API.hs

@@ -19,7 +19,6 @@ module Gargantext.Core.Text.Corpus.API
   ) where
 
 import Conduit
-import Control.Lens ((^.))
 import Data.Bifunctor
 import Data.Either (Either(..))
 import Data.Maybe
@@ -28,7 +27,6 @@ import Gargantext.API.Admin.Orchestrator.Types (ExternalAPIs(..), externalAPIs)
 import Gargantext.Core (Lang(..))
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataDocument(..))
 import Gargantext.Prelude
-import Gargantext.Prelude.Config (GargConfig, gc_pubmed_api_key)
 import qualified Gargantext.Core.Text.Corpus.API.Arxiv   as Arxiv
 import qualified Gargantext.Core.Text.Corpus.API.Hal     as HAL
 import qualified Gargantext.Core.Text.Corpus.API.Isidore as ISIDORE
@@ -45,24 +43,33 @@ data GetCorpusError
   deriving (Show, Eq)
 
 -- | Get External API metadata main function
-get :: GargConfig
-    -> ExternalAPIs
+get :: ExternalAPIs
     -> Lang
     -> Corpus.RawQuery
     -> Maybe Corpus.Limit
     -- -> IO [HyperdataDocument]
     -> IO (Either GetCorpusError (Maybe Integer, ConduitT () HyperdataDocument IO ()))
-get cfg externalAPI la q limit = do
+get api la q limit =
   case Corpus.parseQuery q of
     Left err -> pure $ Left $ InvalidInputQuery q (T.pack err)
-    Right corpusQuery -> case externalAPI of
-      PubMed -> first ExternalAPIError <$>
-                  PUBMED.get (cfg ^. gc_pubmed_api_key) corpusQuery limit
-      --docs <- PUBMED.get   q default_limit -- EN only by default
-      --pure (Just $ fromIntegral $ length docs, yieldMany docs)
-      Arxiv   -> Right <$> Arxiv.get la corpusQuery limit
-      HAL     -> first ExternalAPIError <$> HAL.getC  la (Corpus.getRawQuery q) (Corpus.getLimit <$> limit)
-      IsTex   -> do docs <- ISTEX.get la (Corpus.getRawQuery q) (Corpus.getLimit <$> limit)
-                    pure $ Right (Just $ fromIntegral $ length docs, yieldMany docs)
-      Isidore -> do docs <- ISIDORE.get la (Corpus.getLimit <$> limit) (Just $ Corpus.getRawQuery q) Nothing
-                    pure $ Right (Just $ fromIntegral $ length docs, yieldMany docs)
+    Right corpusQuery ->
+      case api of
+        PubMed { mAPIKey = mAPIKey } -> first ExternalAPIError <$>
+          PUBMED.get (fromMaybe "" mAPIKey) corpusQuery limit
+        --docs <- PUBMED.get   q default_limit -- EN only by default
+        --pure (Just $ fromIntegral $ length docs, yieldMany docs)
+        Arxiv                        -> Right <$> Arxiv.get la corpusQuery limit
+        HAL                          -> first ExternalAPIError <$>
+          HAL.getC  la (Corpus.getRawQuery q) (Corpus.getLimit <$> limit)
+        IsTex                        -> do
+          docs <- ISTEX.get la (Corpus.getRawQuery q) (Corpus.getLimit <$> limit)
+          pure $ Right (Just $ fromIntegral $ length docs, yieldMany docs)
+        Isidore                      -> do
+          docs <- ISIDORE.get la (Corpus.getLimit <$> limit) (Just $ Corpus.getRawQuery q) Nothing
+          pure $ Right (Just $ fromIntegral $ length docs, yieldMany docs)
+        externalApi                  ->
+          panic $ "[G.C.T.Corpus.API] This options are note taken into account: " <>  (cs $ show externalApi)
+
+-- | Some Sugar for the documentation
+-- type Query = PUBMED.Query
+-- type Limit = PUBMED.Limit

src/Gargantext/Core/Text/Corpus/Query.hs

@@ -51,7 +51,7 @@ newtype Limit = Limit { getLimit :: Int }
 -- | An opaque wrapper around a 'Query' type which can be parsed from a boolean
 -- expression like (a AND b) OR c, and which can be interpreted in many ways
 -- according to the particular service we are targeting.
-newtype Query = Query { getQuery :: (BoolExpr.CNF Term) }
+newtype Query = Query { getQuery :: BoolExpr.CNF Term }
   deriving Show
 
 interpretQuery :: Query -> (BoolExpr.BoolExpr Term -> ast) -> ast

src/Gargantext/Database/Action/Flow.hs

@@ -50,6 +50,7 @@ module Gargantext.Database.Action.Flow -- (flowDatabase, ngrams2list)
 
 import Conduit
 import Control.Lens ((^.), view, _Just, makeLenses, over, traverse)
+import Control.Monad.Reader (MonadReader)
 import Data.Aeson.TH (deriveJSON)
 import Data.Conduit.Internal (zipSources)
 import qualified Data.Conduit.List as CList
@@ -131,8 +132,13 @@ deriveJSON (unPrefix "_do_") ''DataOrigin
 instance ToSchema DataOrigin where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_do_")
 
-allDataOrigins :: [DataOrigin]
-allDataOrigins = map InternalOrigin API.externalAPIs <> map ExternalOrigin API.externalAPIs
+allDataOrigins :: ( MonadReader env m
+                  , HasConfig env) => m [DataOrigin]
+allDataOrigins = do
+  ext <- API.externalAPIs
+
+  pure $ map InternalOrigin ext
+      <> map ExternalOrigin ext
 
 ---------------
 data DataText = DataOld ![NodeId]
@@ -154,8 +160,9 @@ getDataText :: FlowCmdM env err m
             -> Maybe API.Limit
             -> m (Either API.GetCorpusError DataText)
 getDataText (ExternalOrigin api) la q li = do
-  cfg  <- view $ hasConfig
-  eRes <- liftBase $ API.get cfg api (_tt_lang la) q li
+  -- cfg  <- view $ hasConfig
+  -- DEPRECATED: Use apiKey per user instead (not the global one)
+  eRes <- liftBase $ API.get api (_tt_lang la) q li
   pure $ DataNew <$> eRes
 
 getDataText (InternalOrigin _) _la q _li = do

src/Gargantext/Database/Query/Table/Node.hs

@@ -342,8 +342,8 @@ getCorpusPubmedAPIKey cId = do
             |]
     params = PGS.Only cId
 
-updateCorpusPubmedAPIKey :: NodeId -> PUBMED.APIKey -> Cmd err Int64
-updateCorpusPubmedAPIKey cId apiKey =
+updateCorpusPubmedAPIKey :: NodeId -> Maybe PUBMED.APIKey -> Cmd err Int64
+updateCorpusPubmedAPIKey cId mAPIKey =
   execPGSQuery query params
   where
     query :: PGS.Query
@@ -352,7 +352,7 @@ updateCorpusPubmedAPIKey cId apiKey =
                 SET hyperdata = hyperdata || ?
                 WHERE id = ?
             |]
-    params = (encode $ object [ "pubmed_api_key" .= apiKey ], cId)
+    params = (encode $ object [ "pubmed_api_key" .= mAPIKey ], cId)
 ------------------------------------------------------------------------
 -- TODO
 -- currently this function removes the child relation

src/Gargantext/Utils/Jobs/Monad.hs

@@ -113,7 +113,7 @@ findJob jid = do
 data JobError
   = InvalidIDType
   | IDExpired
-  | InvalidMacID
+  | InvalidMacID T.Text
   | UnknownJob
   | JobException SomeException
   deriving Show
@@ -127,7 +127,7 @@ checkJID (SJ.PrivateID tn n t d) = do
   js <- getJobsSettings
   if | tn /= "job" -> return (Left InvalidIDType)
      | now > addUTCTime (fromIntegral $ jsIDTimeout js) t -> return (Left IDExpired)
-     | d /= SJ.macID tn (jsSecretKey js) t n -> return (Left InvalidMacID)
+     | d /= SJ.macID tn (jsSecretKey js) t n -> return (Left $ InvalidMacID $ T.pack d)
      | otherwise -> return $ Right (SJ.PrivateID tn n t d)
 
 withJob