Merge remote-tracking branch 'origin/revert-0b51636b' into dev

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

@@ -6,7 +6,6 @@ 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
@@ -24,9 +23,7 @@ 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
@@ -37,39 +34,24 @@ instance Arbitrary a => Arbitrary (JobOutput a) where
 
 -- | Main Types
 -- TODO IsidoreAuth
-data ExternalAPIs = All
-                  | PubMed { mAPIKey :: Maybe Text }
+data ExternalAPIs = PubMed
                   | Arxiv
                   | HAL
                   | IsTex
                   | Isidore
-  deriving (Show, Eq, Generic)
+  deriving (Show, Eq, Generic, Enum, Bounded)
 
 
 -- | Main Instances
 instance FromJSON ExternalAPIs
 instance ToJSON ExternalAPIs
 
-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 ]
+externalAPIs :: [ExternalAPIs]
+externalAPIs = [minBound .. maxBound]
 
 instance Arbitrary ExternalAPIs
   where
-    arbitrary = elements [ All
-                         , PubMed { mAPIKey = Nothing }
-                         , Arxiv
-                         , HAL
-                         , IsTex
-                         , Isidore ]
+    arbitrary = arbitraryBoundedEnum
 
 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(..), UserId)
+import Gargantext.Database.Admin.Types.Node (CorpusId, NodeType(..))
 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)
+import Gargantext.Prelude.Config (gc_max_docs_parsers, gc_pubmed_api_key)
 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,11 +131,8 @@ deriveJSON (unPrefix "") 'ApiInfo
 
 instance ToSchema ApiInfo
 
-info :: FlowCmdM env err m => UserId -> m ApiInfo
-info _u = do
-  ext <- API.externalAPIs
-
-  pure $ ApiInfo ext
+info :: ApiInfo
+info = ApiInfo API.externalAPIs
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
@@ -219,7 +216,8 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
 
     _ -> do
       case datafield of
-         Just (External (PubMed { _api_key })) -> do
+         Just (External PubMed) -> do
+           _api_key <- view $ hasConfig . gc_pubmed_api_key
            printDebug "[addToCorpusWithQuery] pubmed api key" _api_key
            _ <- updateCorpusPubmedAPIKey cid _api_key
            pure ()
@@ -231,7 +229,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
-      db   <- database2origin dbs
+      let 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,55 +3,43 @@
 module Gargantext.API.Node.Corpus.Types where
 
 import Control.Lens hiding (elements, Empty)
-import Control.Monad.Reader (MonadReader)
+import Control.Monad.Fail (fail)
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
 import Data.Monoid (mempty)
 import Data.Swagger
 import GHC.Generics (Generic)
 import Test.QuickCheck
-import qualified PUBMED.Types as PUBMED
+import qualified Data.Text as T
 
 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 { _api_key :: Maybe PUBMED.APIKey }
+              | PubMed
               | Arxiv
               | HAL
               | IsTex
               | Isidore
-  deriving (Eq, Show, Generic)
-
-instance Arbitrary Database
-  where
-    arbitrary = elements [ Empty
-                         , PubMed { _api_key = Nothing }
-                         , Arxiv
-                         , HAL
-                         , IsTex
-                         , Isidore ]
+  deriving (Eq, Show, Generic, Enum, Bounded)
 
+instance Arbitrary Database where
+  arbitrary = arbitraryBoundedEnum
 
 deriveJSON (unPrefix "") ''Database
 instance ToSchema Database where
   declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
 
-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
+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
 
 ------------------------------------------------------------------------
 data Datafield = Gargantext
@@ -60,25 +48,23 @@ data Datafield = Gargantext
                | Files
   deriving (Eq, Show, Generic)
 
-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 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,7 +48,6 @@ 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
@@ -121,15 +120,6 @@ 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)
+import Data.Text (Text, pack)
 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 a }
+showAsServantJSONErr a = err500 { errBody = Aeson.encode $ Aeson.object [ ( "error", Aeson.String $ pack $ show a ) ] }

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

@@ -19,6 +19,7 @@ module Gargantext.Core.Text.Corpus.API
   ) where
 
 import Conduit
+import Control.Lens ((^.))
 import Data.Bifunctor
 import Data.Either (Either(..))
 import Data.Maybe
@@ -27,6 +28,7 @@ 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
@@ -43,33 +45,24 @@ data GetCorpusError
   deriving (Show, Eq)
 
 -- | Get External API metadata main function
-get :: ExternalAPIs
+get :: GargConfig
+    -> ExternalAPIs
     -> Lang
     -> Corpus.RawQuery
     -> Maybe Corpus.Limit
     -- -> IO [HyperdataDocument]
     -> IO (Either GetCorpusError (Maybe Integer, ConduitT () HyperdataDocument IO ()))
-get api la q limit =
+get cfg externalAPI la q limit = do
   case Corpus.parseQuery q of
     Left err -> pure $ Left $ InvalidInputQuery q (T.pack err)
-    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
+    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)

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,7 +50,6 @@ 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
@@ -132,13 +131,8 @@ deriveJSON (unPrefix "_do_") ''DataOrigin
 instance ToSchema DataOrigin where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_do_")
 
-allDataOrigins :: ( MonadReader env m
-                  , HasConfig env) => m [DataOrigin]
-allDataOrigins = do
-  ext <- API.externalAPIs
-
-  pure $ map InternalOrigin ext
-      <> map ExternalOrigin ext
+allDataOrigins :: [DataOrigin]
+allDataOrigins = map InternalOrigin API.externalAPIs <> map ExternalOrigin API.externalAPIs
 
 ---------------
 data DataText = DataOld ![NodeId]
@@ -160,9 +154,8 @@ getDataText :: FlowCmdM env err m
             -> Maybe API.Limit
             -> m (Either API.GetCorpusError DataText)
 getDataText (ExternalOrigin api) la q li = do
-  -- cfg  <- view $ hasConfig
-  -- DEPRECATED: Use apiKey per user instead (not the global one)
-  eRes <- liftBase $ API.get api (_tt_lang la) q li
+  cfg  <- view $ hasConfig
+  eRes <- liftBase $ API.get cfg 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 -> Maybe PUBMED.APIKey -> Cmd err Int64
-updateCorpusPubmedAPIKey cId mAPIKey =
+updateCorpusPubmedAPIKey :: NodeId -> PUBMED.APIKey -> Cmd err Int64
+updateCorpusPubmedAPIKey cId apiKey =
   execPGSQuery query params
   where
     query :: PGS.Query
@@ -352,7 +352,7 @@ updateCorpusPubmedAPIKey cId mAPIKey =
                 SET hyperdata = hyperdata || ?
                 WHERE id = ?
             |]
-    params = (encode $ object [ "pubmed_api_key" .= mAPIKey ], cId)
+    params = (encode $ object [ "pubmed_api_key" .= apiKey ], 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 T.Text
+  | InvalidMacID
   | 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 $ T.pack d)
+     | d /= SJ.macID tn (jsSecretKey js) t n -> return (Left InvalidMacID)
      | otherwise -> return $ Right (SJ.PrivateID tn n t d)
 
 withJob