[API] simulate logs and update async api ok

src/Gargantext/API/Node.hs

@@ -128,7 +128,6 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "table"      :> TableApi
              :<|> "ngrams"     :> TableNgramsApi
 
-             :<|> "update"     :> Update.API
              :<|> "category"   :> CatApi
              :<|> "search"     :> SearchDocsAPI
              :<|> "share"      :> Share.API
@@ -146,6 +145,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "tree"       :> TreeApi
              :<|> "phylo"      :> PhyloAPI
              -- :<|> "add"       :> NodeAddAPI
+             :<|> "update"     :> Update.API
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -203,7 +203,6 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> tableApi             id'
            :<|> apiNgramsTableCorpus id'
             
-           :<|> Update.api  id'
            :<|> catApi      id'
            :<|> searchDocs  id'
            :<|> Share.api   id'
@@ -220,6 +219,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> phyloAPI   id' uId
            -- :<|> nodeAddAPI id'
            -- :<|> postUpload id'
+           :<|> Update.api  uId id'
 
 ------------------------------------------------------------------------
 data RenameNode = RenameNode { r_name :: Text }

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

@@ -38,17 +38,17 @@ type Api = Summary "New Annuaire endpoint"
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-data WithForm = WithForm
+data AnnuaireWithForm = AnnuaireWithForm
   { _wf_filetype :: !NewFile.FileType
   , _wf_data     :: !Text
   , _wf_lang     :: !(Maybe Lang)
   } deriving (Eq, Show, Generic)
 
-makeLenses ''WithForm
-instance FromForm WithForm
-instance FromJSON WithForm where
+makeLenses ''AnnuaireWithForm
+instance FromForm AnnuaireWithForm
+instance FromJSON AnnuaireWithForm where
   parseJSON = genericParseJSON $ jsonOptions "_wf_"
-instance ToSchema WithForm where
+instance ToSchema AnnuaireWithForm where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
 
 ------------------------------------------------------------------------
@@ -62,15 +62,15 @@ type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint"
    :> "add"
    :> "form"
    :> "async"
-   :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus
+   :> AsyncJobs ScraperStatus '[FormUrlEncoded] AnnuaireWithForm ScraperStatus
 
 ------------------------------------------------------------------------
 addToAnnuaireWithForm :: FlowCmdM env err m
                     => AnnuaireId
-                    -> WithForm
+                    -> AnnuaireWithForm
                     -> (ScraperStatus -> m ())
                     -> m ScraperStatus
-addToAnnuaireWithForm _cid (WithForm ft _d _l) logStatus = do
+addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
 
   printDebug "ft" ft
 

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

@@ -150,18 +150,18 @@ instance ToSchema WithQuery where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wq_")
 
 -------------------------------------------------------
-data WithForm = WithForm
+data NewWithForm = NewWithForm
   { _wf_filetype :: !FileType
   , _wf_data     :: !Text
   , _wf_lang     :: !(Maybe Lang)
   , _wf_name     :: !Text
   } deriving (Eq, Show, Generic)
 
-makeLenses ''WithForm
-instance FromForm WithForm
-instance FromJSON WithForm where
+makeLenses ''NewWithForm
+instance FromForm NewWithForm
+instance FromJSON NewWithForm where
   parseJSON = genericParseJSON $ jsonOptions "_wf_"
-instance ToSchema WithForm where
+instance ToSchema NewWithForm where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
 
 ------------------------------------------------------------------------
@@ -193,7 +193,7 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
    :> "add"
    :> "form"
    :> "async"
-     :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithForm ScraperStatus
+     :> AsyncJobs ScraperStatus '[FormUrlEncoded] NewWithForm ScraperStatus
 
 
 ------------------------------------------------------------------------
@@ -229,10 +229,10 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
 addToCorpusWithForm :: FlowCmdM env err m
                     => User
                     -> CorpusId
-                    -> WithForm
+                    -> NewWithForm
                     -> (ScraperStatus -> m ())
                     -> m ScraperStatus
-addToCorpusWithForm user cid (WithForm ft d l _n) logStatus = do
+addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
 
   let
     parse = case ft of

src/Gargantext/API/Node/Update.hs

@@ -16,18 +16,24 @@ Portability : POSIX
 module Gargantext.API.Node.Update
       where
 
-import Prelude (Enum, Bounded, minBound, maxBound)
 import Data.Aeson
 import Data.Swagger
 import GHC.Generics (Generic)
+import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
+import Gargantext.API.Node.Corpus.New (AsyncJobs)
+import Gargantext.API.Prelude (GargServer, simuLogs)
+import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
-import Gargantext.Prelude
+import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.))
+import Prelude (Enum, Bounded, minBound, maxBound)
 import Servant
+import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
+
+
+
 ------------------------------------------------------------------------
 data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: Method      }
                       | UpdateNodeParamsGraph { methodGraph :: GraphMetric }
@@ -89,16 +95,21 @@ instance Arbitrary Charts where
   arbitrary = elements [ minBound .. maxBound ]
 
 ------------------------------------------------------------------------
-api :: HasNodeError err
-    => NodeId
+api :: UserId -> NodeId -> GargServer API
+api uId nId =
+  serveJobsAPI $ 
+    JobFunction (\p logs -> updateNode uId nId p (liftBase . logs))
+
+
+updateNode :: FlowCmdM env err m
+    => UserId
+    -> NodeId
     -> UpdateNodeParams
-    -> Cmd err Int
-api _nId (UpdateNodeParamsList  _meth) = pure 1
-api _nId (UpdateNodeParamsGraph _meth) = pure 1
-api _nId (UpdateNodeParamsTexts _meth) = pure 1
-api _nId (UpdateNodeParamsBoard _meth) = pure 1
+    -> (ScraperStatus -> m ())
+    -> m ScraperStatus
+updateNode _uId _nId _ logStatus = do
+  simuLogs logStatus 100
 
 ------------------------------------------------------------------------
 type API = Summary " Share Node with username"
-         :> ReqBody '[JSON] UpdateNodeParams
-         :> Post    '[JSON] Int
+         :> AsyncJobs ScraperStatus '[JSON] UpdateNodeParams ScraperStatus

src/Gargantext/API/Prelude.hs

@@ -22,6 +22,7 @@ module Gargantext.API.Prelude
   )
   where
 
+import Control.Concurrent (threadDelay)
 import Control.Exception (Exception)
 import Control.Lens (Prism', (#))
 import Control.Lens.TH (makePrisms)
@@ -36,9 +37,9 @@ import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Admin.Settings
 import Gargantext.API.Ngrams
 import Gargantext.Core.Types
-import Gargantext.Database.Query.Tree
-import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
 import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
+import Gargantext.Database.Query.Tree
 import Gargantext.Prelude
 import Servant
 import Servant.Job.Async (HasJobEnv)
@@ -146,3 +147,45 @@ instance HasServerError GargError where
 
 instance HasJoseError GargError where
   _JoseError = _GargJoseError
+
+
+------------------------------------------------------------------------
+-- | Utils
+-- | Simulate logs
+
+simuLogs  :: MonadBase IO m
+         => (ScraperStatus -> m a)
+         -> Int
+         -> m ScraperStatus
+simuLogs logStatus t = do
+  let task = ScraperStatus { _scst_succeeded = Just 0
+                           , _scst_failed    = Just 0
+                           , _scst_remaining = Just 0
+                           , _scst_events    = Just []
+                           }
+  f <- foldM' (\status n -> simuTask logStatus status n t) task $ take t [1..]
+  pure f
+
+
+simuTask :: MonadBase IO m
+         => (ScraperStatus -> m a)
+         -> ScraperStatus
+         -> Int
+         -> Int
+         -> m ScraperStatus
+simuTask logStatus (ScraperStatus s f _r e) n t = do
+  let
+    m = (10 :: Int) ^ (6 :: Int)
+  _ <- liftBase $ threadDelay ( m * 10)
+
+  let status =  ScraperStatus { _scst_succeeded = (+) <$> s <*> Just n
+                              , _scst_failed    = f
+                              , _scst_remaining = (-) <$> Just t <*> s
+                              , _scst_events    = e
+                              }
+  printDebug "status" status
+  _ <- logStatus status
+  pure status
+
+
+

src/Gargantext/Prelude.hs

@@ -59,6 +59,7 @@ import Protolude ( Bool(True, False), Int, Int64, Double, Integer
                  , compare
                  , on
                  , panic
+                 , seq
                  )
 
 import Prelude (Enum, Bounded, minBound, maxBound, putStrLn)
@@ -307,4 +308,12 @@ lookup2 a b m = do
   m' <- lookup a m
   lookup b m'
 
+-----------------------------------------------
+
+foldM' :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
+foldM' _ z [] = return z
+foldM' f z (x:xs) = do
+  z' <- f z x
+  z' `seq` foldM' f z' xs
+