[worker] job comments added

Also, some import refactoring

gargantext.cabal

@@ -127,6 +127,7 @@ library
       Gargantext.API.Ngrams.Tools
       Gargantext.API.Ngrams.Types
       Gargantext.API.Node
+      Gargantext.API.Node.Contact.Types
       Gargantext.API.Node.Corpus.Annuaire
       Gargantext.API.Node.Corpus.New
       Gargantext.API.Node.Corpus.New.Types
@@ -137,6 +138,8 @@ library
       Gargantext.API.Node.File
       Gargantext.API.Node.File.Types
       Gargantext.API.Node.FrameCalcUpload.Types
+      Gargantext.API.Node.Get
+      Gargantext.API.Node.New.Types
       Gargantext.API.Node.Share
       Gargantext.API.Node.Share.Types
       Gargantext.API.Node.ShareURL
@@ -316,7 +319,6 @@ library
       Gargantext.API.Metrics
       Gargantext.API.Ngrams.NgramsTree
       Gargantext.API.Node.Contact
-      Gargantext.API.Node.Contact.Types
       Gargantext.API.Node.Corpus.Export
       Gargantext.API.Node.Corpus.Export.Types
       Gargantext.API.Node.Corpus.Searx
@@ -327,9 +329,7 @@ library
       Gargantext.API.Node.DocumentUpload
       Gargantext.API.Node.DocumentsFromWriteNodes
       Gargantext.API.Node.FrameCalcUpload
-      Gargantext.API.Node.Get
       Gargantext.API.Node.New
-      Gargantext.API.Node.New.Types
       Gargantext.API.Public.Types
       Gargantext.API.Search
       Gargantext.API.Search.Types

src/Gargantext/API/Node/Contact.hs

@@ -22,7 +22,7 @@ import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(AuthenticatedUser) )
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Node ( nodeNodeAPI )
-import Gargantext.API.Node.Contact.Types
+import Gargantext.API.Node.Contact.Types (AddContactParams(..))
 import Gargantext.API.Prelude (GargM, simuLogs)
 import Gargantext.API.Routes.Named.Contact qualified as Named
 import Gargantext.API.Worker (serveWorkerAPI)
@@ -41,6 +41,7 @@ import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
 import Servant
 import Servant.Server.Generic (AsServerT)
 
+
 contactAPI :: AuthenticatedUser -> CorpusId -> Named.ContactAPI (AsServerT (GargM Env BackendInternalError))
 contactAPI authUser@(AuthenticatedUser userNodeId _userUserId) cid = Named.ContactAPI
   { contactAsyncAPI = apiAsync (RootId userNodeId) cid
@@ -55,7 +56,6 @@ apiAsync u nId = Named.ContactAsyncAPI {
                         , _ac_node_id = nId
                         , _ac_user = u }
     }
-    -- addContact u nId p jHandle
 
 addContact :: (FlowCmdM env err m, MonadJobStatus m)
     => User

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

@@ -12,11 +12,9 @@ Portability : POSIX
 module Gargantext.API.Node.Contact.Types where
 
 import Data.Aeson
-import Data.Swagger
-import GHC.Generics
+import Data.Swagger (ToSchema)
 import Gargantext.Prelude
 import Gargantext.Utils.Aeson qualified as GUA
-import Test.QuickCheck
 
 ------------------------------------------------------------------------
 data AddContactParams = AddContactParams         { firstname :: !Text, lastname :: !Text }
@@ -35,7 +33,5 @@ instance ToJSON    AddContactParams where
   toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 
 instance ToSchema  AddContactParams
-instance Arbitrary AddContactParams where
-  arbitrary = elements [AddContactParams "Pierre" "Dupont"]
 
 ------------------------------------------------------------------------

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

@@ -14,9 +14,8 @@ Portability : POSIX
 module Gargantext.API.Node.Corpus.Annuaire
       where
 
-import Control.Lens hiding (elements)
-import Data.Aeson
-import Data.Swagger
+import Data.Aeson (genericParseJSON, genericToJSON)
+import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
 import Gargantext.API.Node.Corpus.New.Types qualified as NewTypes
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)

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

@@ -20,7 +20,7 @@ module Gargantext.API.Node.Corpus.New
       where
 
 
-import Conduit
+import Conduit ((.|), yieldMany, mapMC, mapC, transPipe)
 import Control.Lens ( view, non )
 import Data.ByteString.Base64 qualified as BSB64
 import Data.Conduit.Internal (zipSources)

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

@@ -10,13 +10,10 @@ Portability : POSIX
 
 module Gargantext.API.Node.Corpus.New.Types where
 
-import Data.Aeson
-import Data.Swagger
+import Data.Swagger (ToSchema, ToParamSchema)
 import Data.Text (pack)
 import Gargantext.Prelude
 import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 data FileType = TSV
               | TSV_HAL
@@ -27,7 +24,6 @@ data FileType = TSV
               | JSON
   deriving (Eq, Show, Generic)
 instance ToSchema FileType
-instance Arbitrary FileType where arbitrary = elements [TSV, PresseRIS]
 instance ToParamSchema FileType
 instance FromJSON FileType
 instance ToJSON FileType
@@ -47,7 +43,6 @@ instance ToHttpApiData FileType where
 data FileFormat = Plain | ZIP
   deriving (Eq, Show, Generic)
 instance ToSchema FileFormat
-instance Arbitrary FileFormat where arbitrary = elements [ Plain, ZIP ]
 instance ToParamSchema FileFormat
 instance FromJSON FileFormat
 instance ToJSON FileFormat

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

@@ -43,7 +43,7 @@ import Gargantext.Database.Query.Table.Node (getOrMkList, insertDefaultNodeIfNot
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Tree.Error (HasTreeError)
 import Gargantext.Database.Query.Tree.Root (getOrMkRootWithCorpus, MkCorpusUser (MkCorpusUserMaster))
-import Gargantext.Prelude hiding (All)
+import Gargantext.Prelude
 import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(..))
 import Network.HTTP.Client
 import Network.HTTP.Client.TLS (tlsManagerSettings)

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

@@ -22,7 +22,6 @@ import Gargantext.API.Admin.Orchestrator.Types qualified as Types
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Action.Flow.Types (DataOrigin(..))
 import Gargantext.Prelude
-import Test.QuickCheck (Arbitrary(..), oneof, arbitraryBoundedEnum)
 
 data Database = Empty
               | OpenAlex
@@ -34,9 +33,6 @@ data Database = Empty
               | EPO
   deriving (Eq, Show, Generic, Enum, Bounded)
 
-instance Arbitrary Database where
-  arbitrary = arbitraryBoundedEnum
-
 deriveJSON (unPrefix "") ''Database
 instance ToSchema Database where
   declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
@@ -72,9 +68,6 @@ instance ToJSON Datafield where
   toJSON (External db) = toJSON $ object [ ("External", toJSON db) ]
   toJSON s = toJSON (show s :: Text)
 
-instance Arbitrary Datafield where
-  arbitrary = oneof [pure Gargantext, pure Web, pure Files, External <$> arbitrary]
-
 instance ToSchema Datafield where
   declareNamedSchema _ = do
     pure $ NamedSchema (Just "Datafield") $ mempty

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

@@ -16,13 +16,12 @@ module Gargantext.API.Node.Corpus.Update
   where
 
 import Control.Lens (over)
-import Control.Monad
-import Gargantext.Core
-import Gargantext.Database.Admin.Types.Hyperdata.Corpus
-import Gargantext.Database.Admin.Types.Node
+import Gargantext.Core (Lang)
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus, _hc_lang)
+import Gargantext.Database.Admin.Types.Node (CorpusId)
 import Gargantext.Database.Prelude (DbCmd')
-import Gargantext.Database.Query.Table.Node
-import Gargantext.Database.Query.Table.Node.Error
+import Gargantext.Database.Query.Table.Node (getNodeWith)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude

src/Gargantext/API/Node/DocumentsFromWriteNodes.hs

@@ -23,14 +23,14 @@ import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser, auth_node_id, auth_u
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
-import Gargantext.API.Node.DocumentsFromWriteNodes.Types
+import Gargantext.API.Node.DocumentsFromWriteNodes.Types (Params(..))
 import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Routes.Named.Document qualified as Named
 import Gargantext.API.Worker (serveWorkerAPI)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion)
 import Gargantext.Core.Text.Corpus.Parsers.Date (split')
-import Gargantext.Core.Text.Corpus.Parsers.FrameWrite
+import Gargantext.Core.Text.Corpus.Parsers.FrameWrite (Author(..), Parsed(..), parseLines, text2titleParagraphs)
 import Gargantext.Core.Text.Terms (TermType(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
@@ -42,9 +42,9 @@ import Gargantext.Database.Admin.Types.Node ( NodeId, Node, NodeType(..) )
 import Gargantext.Database.Query.Table.Node (getChildrenByType, getClosestParentIdByType', getNodeWith, getOrMkList)
 import Gargantext.Database.Schema.Node (node_hyperdata, node_name, node_date)
 import Gargantext.Prelude
-import Gargantext.System.Logging
+import Gargantext.System.Logging (logLocM, LogLevel(..))
 import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
-import Gargantext.Utils.Jobs.Error
+import Gargantext.Utils.Jobs.Error (HumanFriendlyErrorText(..))
 import Servant.Server.Generic (AsServerT)
 
 api :: AuthenticatedUser

src/Gargantext/API/Node/Get.hs

@@ -11,11 +11,6 @@ Polymorphic Get Node API
 
 -}
 
-{-# OPTIONS_GHC -fno-warn-deprecations #-}
-
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE TypeOperators      #-}
-
 module Gargantext.API.Node.Get
       where
 
@@ -23,7 +18,6 @@ import Data.Aeson
 import Data.Swagger
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Prelude
-import Test.QuickCheck.Arbitrary
 
 ------------------------------------------------------------------------
 data GetNodeParams = GetNodeParams { node_id  :: NodeId 
@@ -39,7 +33,5 @@ instance ToJSON    GetNodeParams where
   toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
   
 instance ToSchema  GetNodeParams
-instance Arbitrary GetNodeParams where
-  arbitrary = GetNodeParams <$> arbitrary <*> arbitrary
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/New.hs

@@ -18,18 +18,18 @@ module Gargantext.API.Node.New
       where
 
 import Control.Lens hiding (elements, Empty)
-import Gargantext.API.Admin.Auth.Types
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, auth_user_id)
 import Gargantext.API.Admin.EnvTypes (Env)
-import Gargantext.API.Errors.Types
-import Gargantext.API.Node.New.Types
-import Gargantext.API.Prelude
+import Gargantext.API.Errors.Types (BackendInternalError)
+import Gargantext.API.Node.New.Types (PostNode(..))
+import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Routes.Named.Node qualified as Named
 import Gargantext.API.Worker (serveWorkerAPI)
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
-import Gargantext.Database.Action.Node
+import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Prelude (CmdM, DBCmd')
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))

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

@@ -13,13 +13,10 @@ module Gargantext.API.Node.New.Types (
   PostNode(..)
   ) where
 
-import Data.Aeson
-import Data.Swagger
-import GHC.Generics
+import Data.Swagger (ToSchema)
 import Gargantext.Core.Types (NodeType (..))
 import Gargantext.Prelude
-import Test.QuickCheck
-import Web.FormUrlEncoded
+import Web.FormUrlEncoded (FromForm, ToForm)
 
 ------------------------------------------------------------------------
 data PostNode = PostNode { pn_name     :: Text
@@ -32,6 +29,4 @@ instance ToJSON    PostNode
 instance ToSchema  PostNode
 instance FromForm  PostNode
 instance ToForm    PostNode
-instance Arbitrary PostNode where
-  arbitrary = elements [PostNode "Node test" NodeCorpus]
 

src/Gargantext/API/Node/Phylo/Export.hs

@@ -11,7 +11,7 @@ Portability : POSIX
 module Gargantext.API.Node.Phylo.Export
   where
 
-import Data.Aeson
+import Data.Aeson (Value)
 import Data.Text qualified as T
 import Gargantext.API.Prelude (GargNoServer, IsGargServer)
 import Gargantext.API.Routes.Named.Viz qualified as Named

src/Gargantext/API/Node/Phylo/Export/Types.hs

@@ -13,20 +13,20 @@ Portability : POSIX
 
 module Gargantext.API.Node.Phylo.Export.Types where
 
-import Data.Aeson.TH (deriveJSON)
+ --, PlainText, MimeRender(..)
 -- import Data.Csv (DefaultOrdered(..), ToNamedRecord(..), (.=), header, namedRecord)
-import Data.Swagger ( genericDeclareNamedSchema, ToParamSchema(..), ToSchema(..) )
 -- import Data.Text qualified as T
 -- import Data.Text.Encoding qualified as TE
+-- import Gargantext.Database.Schema.Node (NodePoly(..))
+-- import Gargantext.Utils.Servant (ZIP)
+-- import Gargantext.Utils.Zip (zipContentsPure)
+import Data.Aeson.TH (deriveJSON)
+import Data.Swagger ( genericDeclareNamedSchema, ToParamSchema(..), ToSchema(..) )
 import Gargantext.Core.Types ( Node, TODO )
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Admin.Types.Hyperdata.Phylo ( HyperdataPhylo(..) )
 import Gargantext.Database.Admin.Types.Node (PhyloId)
--- import Gargantext.Database.Schema.Node (NodePoly(..))
--- import Gargantext.Utils.Servant (ZIP)
--- import Gargantext.Utils.Zip (zipContentsPure)
 import Protolude
- --, PlainText, MimeRender(..)
 
 
 -- | Phylo Export

src/Gargantext/API/Node/Share.hs

@@ -17,17 +17,17 @@ module Gargantext.API.Node.Share
 
 import Data.List qualified as List
 import Data.Text qualified as Text
-import Gargantext.API.Node.Share.Types
-import Gargantext.API.Prelude
+import Gargantext.API.Node.Share.Types (ShareNodeParams(..))
+import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.API.Routes.Named.Share qualified as Named
 import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification)
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
 import Gargantext.Database.Action.Share (ShareNodeWith(..))
 import Gargantext.Database.Action.Share as DB (shareNodeWith, unPublish)
-import Gargantext.Database.Action.User
-import Gargantext.Database.Action.User.New
-import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Action.User (getUserId', getUsername)
+import Gargantext.Database.Action.User.New (guessUserName, newUser)
+import Gargantext.Database.Admin.Types.Node (NodeId, NodeType(..), UserId(..))
 import Gargantext.Database.Prelude (CmdRandom)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Tree (findNodesWithType)

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

@@ -2,12 +2,11 @@
 module Gargantext.API.Node.Share.Types where
 
 import Data.Aeson
-import Data.Swagger
-import Gargantext.Database.Admin.Types.Node
+import Data.Swagger (ToSchema)
+import Gargantext.Database.Admin.Types.Node (NodeId)
 import Gargantext.Prelude
 import Gargantext.Utils.Aeson qualified as GUA
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary
+
 
 data ShareNodeParams = ShareTeamParams   { username :: Text  }
                      | SharePublicParams { node_id  :: NodeId }
@@ -19,7 +18,3 @@ instance FromJSON  ShareNodeParams where
 instance ToJSON    ShareNodeParams where
   toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 instance ToSchema  ShareNodeParams
-instance Arbitrary ShareNodeParams where
-  arbitrary = elements [ ShareTeamParams "user1"
-                       , SharePublicParams (UnsafeMkNodeId 1)
-                       ]

src/Gargantext/API/Node/ShareURL.hs

-{-# LANGUAGE TypeOperators        #-}
-{-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeOperators        #-}
 
 module Gargantext.API.Node.ShareURL where
 
-import Control.Lens
+import Control.Lens (view, (#))
 import Data.Text qualified as T
 import Data.Validity qualified as V
-import Gargantext.API.Prelude
+import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.API.Routes.Named.Share qualified as Named
 import Gargantext.Core.Config (GargConfig, gc_frontend_config, HasConfig(hasConfig))
 import Gargantext.Core.Config.Types (fc_appPort, fc_url)

src/Gargantext/API/Node/Types.hs

@@ -13,10 +13,10 @@ Portability : POSIX
 module Gargantext.API.Node.Types where
 
 import Control.Lens hiding (elements, Empty)
-import Data.Aeson
+import Data.Aeson (genericParseJSON, genericToJSON)
 import Data.ByteString qualified as BS
 import Data.ByteString.Base64 qualified as BSB64
-import Data.Swagger
+import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
 import Data.Text qualified as T
 import Gargantext.API.Node.Corpus.New.Types (FileType, FileFormat)
 import Gargantext.API.Node.Corpus.Types
@@ -28,7 +28,7 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.GargDB qualified as GargDB
 import Gargantext.Prelude
 import Servant.Job.Utils (jsonOptions)
-import Web.FormUrlEncoded          (FromForm, ToForm)
+import Web.FormUrlEncoded (FromForm, ToForm)
 
 -------------------------------------------------------
 data NewWithForm = NewWithForm

src/Gargantext/API/Node/Update.hs

@@ -21,7 +21,7 @@ import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Metrics qualified as Metrics
 import Gargantext.API.Ngrams.Types qualified as NgramsTypes
-import Gargantext.API.Node.Update.Types
+import Gargantext.API.Node.Update.Types (Method(..), UpdateNodeParams(..), UpdateNodeConfigGraph(..))
 import Gargantext.API.Prelude (GargM, simuLogs)
 import Gargantext.API.Routes.Named.Node qualified as Named
 import Gargantext.API.Worker (serveWorkerAPI)

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

@@ -11,8 +11,6 @@ import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
 import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType )
 import Gargantext.Prelude
 import Gargantext.Utils.Aeson qualified as GUA
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
 
 ------------------------------------------------------------------------
 data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: !Method      }
@@ -65,44 +63,23 @@ instance ToJSON    UpdateNodeParams where
   toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
 
 instance ToSchema  UpdateNodeParams
-instance Arbitrary UpdateNodeParams where
-  arbitrary = do
-    l <- UpdateNodeParamsList  <$> arbitrary
-    g <- UpdateNodeParamsGraph <$> arbitrary
-    t <- UpdateNodeParamsTexts <$> arbitrary
-    b <- UpdateNodeParamsBoard <$> arbitrary
-    elements [l,g,t,b]
 
 instance FromJSON  Method
 instance ToJSON    Method
 instance ToSchema  Method
-instance Arbitrary Method where
-  arbitrary = elements [ minBound .. maxBound ]
 
 instance FromJSON  Granularity
 instance ToJSON    Granularity
 instance ToSchema  Granularity
-instance Arbitrary Granularity where
-  arbitrary = elements [ minBound .. maxBound ]
 
 instance FromJSON  Charts
 instance ToJSON    Charts
 instance ToSchema  Charts
-instance Arbitrary Charts where
-  arbitrary = elements [ minBound .. maxBound ]
 
 instance FromJSON UpdateNodeConfigGraph
 instance ToJSON UpdateNodeConfigGraph
 instance ToSchema UpdateNodeConfigGraph
-instance Arbitrary UpdateNodeConfigGraph where
-  arbitrary = do
-    methodGraphMetric        <- arbitrary
-    methodGraphClustering    <- arbitrary
-    methodGraphBridgeness    <- arbitrary
-    methodGraphEdgesStrength <- arbitrary
-    methodGraphNodeType1     <- arbitrary
-    methodGraphNodeType2     <- arbitrary
-    return $ UpdateNodeConfigGraph methodGraphMetric methodGraphClustering methodGraphBridgeness
-        methodGraphEdgesStrength methodGraphNodeType1 methodGraphNodeType2
 
 ------------------------------------------------------------------------
+
+

src/Gargantext/Core/Notifications/Dispatcher/WebSocket.hs

@@ -31,7 +31,7 @@ import Gargantext.Core.Notifications.Dispatcher.Types
 import Gargantext.Core.Notifications.Dispatcher (Dispatcher, dispatcherSubscriptions)
 import Gargantext.Core.Config (HasJWTSettings(jwtSettings))
 import Gargantext.Prelude
-import Gargantext.System.Logging (LogLevel(DEBUG), logMsg, withLogger, logM)
+import Gargantext.System.Logging (LogLevel(..), logMsg, withLogger, logM)
 import Network.WebSockets qualified as WS
 import Servant
 import Servant.API.WebSocket qualified as WS (WebSocketPending)
@@ -67,7 +67,9 @@ wsServer = WSAPI { wsAPIServer = streamData }
             case err of
               WS.ConnectionClosed -> logM DEBUG $ "[wsServer] connection closed"
               WS.CloseRequest _ _ -> logM DEBUG $ "[wsServer] close request"
-              _ -> Exc.throw err ]
+              _ -> do
+                logM ERROR $ "[wsServer] error: " <> show err
+                Exc.throw err ]
 
   
 -- | Send a ping control frame periodically, otherwise the
@@ -148,13 +150,13 @@ getWSKey pc = do
   -- WebSocket specification says that a pending request should send
   -- some unique, Sec-WebSocket-Key string. We use this to compare
   -- connections (WS.Connection doesn't implement an Eq instance).
+  liftBase $ withLogger () $ \ioLogger -> do
+    logMsg ioLogger DEBUG $ "[wsLoop, getWSKey] headers: " <> show (WS.requestHeaders reqHead)
   let mKey = head $ filter (\(k, _) -> k == "Sec-WebSocket-Key") $ WS.requestHeaders reqHead
   let key' = snd $ fromMaybe (panicTrace "Sec-WebSocket-Key not found!") mKey
   -- Unfortunately, a single browsers sends the same
   -- Sec-WebSocket-Key so we want to make that even more unique.
   uuid <- liftBase $ UUID.nextRandom
   let key = key' <> "-" <> show uuid
-  liftBase $ withLogger () $ \ioLogger -> do
-    logMsg ioLogger DEBUG $ "[wsLoop, getWSKey] request headers: " <> (show $ WS.requestHeaders reqHead)
 
   pure key

src/Gargantext/Core/Worker.hs

@@ -216,53 +216,82 @@ performAction env _state bm = do
   let ji = JobInfo { _ji_message_id = messageId bm
                    , _ji_mNode_id = getWorkerMNodeId job }
   let jh = WorkerJobHandle { _w_job_info = ji }
+  
   case job of
     Ping -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] ping"
       liftIO $ CE.notify (env ^. (to _w_env_config) . gc_notifications_config) CET.Ping
+      
+    -- | flow action for a single contact
     AddContact { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] add contact"
       addContact _ac_user _ac_node_id _ac_args jh
+      
+    -- | Send a file with documents and index them in corpus
     AddCorpusFormAsync { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] add corpus form"
       addToCorpusWithForm _acf_user _acf_cid _acf_args jh
+      
+    -- | Perform external API search query and index documents in corpus
     AddCorpusWithQuery { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] add corpus with query"
       let limit = Just $ fromIntegral $ env ^. hasConfig . gc_jobs . jc_max_docs_scrapers
       addToCorpusWithQuery _acq_user _acq_cid _acq_args limit jh
+      
+    -- | Add to annuaire, from given file (not implemented yet)
     AddToAnnuaireWithForm { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] add to annuaire with form"
       Annuaire.addToAnnuaireWithForm _aawf_annuaire_id _aawf_args jh
+      
+    -- | Saves file to 'data_filepath' (in TOML), adds this file as a node
     AddWithFile { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] add with file"
       addWithFile _awf_authenticatedUser _awf_node_id _awf_args jh
+
+    -- | For given corpus, get write nodes contents and create documents from it
     DocumentsFromWriteNodes { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] documents from write nodes"
       documentsFromWriteNodes _dfwn_authenticatedUser _dfwn_node_id _dfwn_args jh
+
+    -- | Forgot password task
     ForgotPasswordAsync { _fpa_args = ForgotPasswordAsyncParams { email } } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] forgot password: " <> email
       us <- getUsersWithEmail (T.toLower email)
       case us of
         [u] -> forgotUserPassword u
         _ -> pure ()
+
+    -- | Add given calc frame into corpus (internall, as a TSV file upload)
     FrameCalcUpload { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG "[performAction] frame calc upload"
       frameCalcUploadAsync _fca_authenticatedUser _fca_node_id _fca_args jh
+
+    -- | Process uploaded JSON file
     JSONPost { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] json post"
       void $ postAsyncJSON _jp_list_id _jp_ngrams_list jh
+
+    -- | Task for updating metrics charts
     NgramsPostCharts { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] ngrams post charts"
       void $ tableNgramsPostChartsAsync _npc_args jh
+
+    -- | Creates node of given type
     PostNodeAsync { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] post node async"
       void $ postNode' _pna_authenticatedUser _pna_node_id _pna_args
+
+    -- | Recompute graph (for sigmajs)
     RecomputeGraph { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] recompute graph"
       void $ graphRecompute _rg_node_id jh
+
+    -- | Updates a node (which triggers graph)
     UpdateNode { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] update node"
       void $ updateNode _un_node_id _un_args jh
+
+    -- | Upload a document
     UploadDocument { .. } -> runWorkerMonad env $ do
       $(logLocM) DEBUG $ "[performAction] upload document"
       void $ documentUploadAsync _ud_node_id _ud_args jh

src/Gargantext/Core/Worker/Jobs.hs

@@ -30,10 +30,10 @@ sendJob :: (HasWorkerBroker, HasConfig env)
         -> Cmd' env err MessageId
 sendJob job = do
   gcConfig <- view $ hasConfig
-  liftBase $ sendJobCfg gcConfig job
+  liftBase $ sendJobWithCfg gcConfig job
 
-sendJobCfg :: GargConfig -> Job -> IO MessageId
-sendJobCfg gcConfig job = do
+sendJobWithCfg :: GargConfig -> Job -> IO MessageId
+sendJobWithCfg gcConfig job = do
   let ws@WorkerSettings { _wsDefinitions, _wsDefaultDelay } = gcConfig ^. gc_worker
   -- TODO Try to guess which worker should get this job
   -- let mWd = findDefinitionByName ws workerName
@@ -50,6 +50,17 @@ sendJobCfg gcConfig job = do
 
 -- | We want to fine-tune job metadata parameters, for each job type
 updateJobData :: Job -> SendJob -> SendJob
-updateJobData (AddCorpusFormAsync {}) sj = sj { W.timeout = 300 }
+updateJobData (AddCorpusFormAsync {}) sj = sj { W.timeout = 3000 }
 updateJobData (AddCorpusWithQuery {}) sj = sj { W.timeout = 3000 }
-updateJobData _ sj = sj { W.resendOnKill = False }
+updateJobData (AddToAnnuaireWithForm {}) sj = sj { W.timeout = 3000 }
+updateJobData (AddWithFile {}) sj = sj { W.timeout = 3000 }
+updateJobData (DocumentsFromWriteNodes {}) sj = sj { W.timeout = 3000 }
+updateJobData (FrameCalcUpload {}) sj = sj { W.timeout = 3000 }
+updateJobData (JSONPost {}) sj = sj { W.timeout = 3000 }
+updateJobData (NgramsPostCharts {}) sj = sj { W.timeout = 3000 }
+updateJobData (RecomputeGraph {}) sj = sj { W.timeout = 3000 }
+updateJobData (UpdateNode {}) sj = sj { W.timeout = 3000 }
+updateJobData (UploadDocument {}) sj = sj { W.timeout = 3000 }
+-- | ForgotPasswordAsync, PostNodeAsync
+updateJobData _ sj = sj { W.resendOnKill = False
+                        , W.timeout = 60 }

src/Gargantext/Database/Admin/Types/Metrics.hs

+{-|
+Module      : Gargantext.Database.Admin.Types.Metrics
+Description : 
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
 {-# LANGUAGE TemplateHaskell            #-}
 
 module Gargantext.Database.Admin.Types.Metrics where
 
-import Data.Aeson.TH (deriveJSON)
-import Data.Swagger
+import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
 import Data.Vector (Vector)
-import qualified Data.Vector as V
-import Protolude
-import Test.QuickCheck.Arbitrary
-
+import Data.Vector qualified as V
 import Gargantext.Core.Types (ListType(..))
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
+import Gargantext.Prelude
+import Test.QuickCheck.Arbitrary
 
 ----------------------------------------------------------------------------
 

test/Test/Instances.hs

@@ -24,20 +24,26 @@ import EPO.API.Client.Types qualified as EPO
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..), ForgotPasswordAsyncParams(..))
 import Gargantext.API.Errors.Types qualified as Errors
 import Gargantext.API.Ngrams.Types qualified as Ngrams
+import Gargantext.API.Node.Contact.Types (AddContactParams(..))
 import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm(..))
 import Gargantext.API.Node.Corpus.New (ApiInfo(..))
+import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..))
+import Gargantext.API.Node.Corpus.Types (Datafield(..), Database(..))
 import Gargantext.API.Node.DocumentsFromWriteNodes.Types qualified as DFWN
 import Gargantext.API.Node.DocumentUpload.Types (DocumentUpload(..))
 import Gargantext.API.Node.FrameCalcUpload.Types qualified as FCU
+import Gargantext.API.Node.Get (GetNodeParams(..))
+import Gargantext.API.Node.New.Types (PostNode(..))
+import Gargantext.API.Node.Share.Types (ShareNodeParams(..))
+import Gargantext.API.Node.Update.Types qualified as NU
 import Gargantext.API.Node.Types (NewWithForm(..), RenameNode(..), WithQuery(..))
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
 import Gargantext.Core.Notifications.Dispatcher.Types qualified as DET
 import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
 import Gargantext.Core.Worker.Jobs.Types (Job(..))
-import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId))
 import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
-import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId), NodeType(..))
+import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId(..), NodeType(..))
 import Gargantext.Prelude hiding (replace, Location)
 import Servant.Job.Core qualified as SJ
 import Servant.Job.Types qualified as SJ
@@ -114,6 +120,15 @@ instance Arbitrary EPO.Token where
 instance Arbitrary ApiInfo where
   arbitrary = ApiInfo <$> arbitrary
 
+instance Arbitrary FileFormat where
+  arbitrary = elements [ Plain, ZIP ]
+instance Arbitrary FileType where
+  arbitrary = elements [TSV, PresseRIS]
+
+instance Arbitrary Database where
+  arbitrary = arbitraryBoundedEnum
+instance Arbitrary Datafield where
+  arbitrary = oneof [pure Gargantext, pure Web, pure Files, External <$> arbitrary]
 
 instance Arbitrary WithQuery where
   arbitrary = do
@@ -135,6 +150,9 @@ instance Arbitrary AnnuaireWithForm where
                                <*> arbitrary   -- _wf_data
                                <*> arbitrary    -- _wf_lang
 
+instance Arbitrary AddContactParams where
+  arbitrary = elements [ AddContactParams "Pierre" "Dupont" ]
+
 instance Arbitrary DFWN.Params where
   arbitrary = DFWN.Params <$> arbitrary  -- id
                           <*> arbitrary  -- paragraphs
@@ -148,6 +166,45 @@ instance Arbitrary FCU.FrameCalcUpload where
   arbitrary = FCU.FrameCalcUpload <$> arbitrary   -- _wf_lang
                                   <*> arbitrary   -- _wf_selection
 
+instance Arbitrary GetNodeParams where
+  arbitrary = GetNodeParams <$> arbitrary <*> arbitrary
+
+instance Arbitrary PostNode where
+  arbitrary = elements [PostNode "Node test" NodeCorpus]
+
+instance Arbitrary ShareNodeParams where
+  arbitrary = elements [ ShareTeamParams "user1"
+                       , SharePublicParams (UnsafeMkNodeId 1)
+                       ]
+
+instance Arbitrary NU.UpdateNodeParams where
+  arbitrary = do
+    l <- NU.UpdateNodeParamsList  <$> arbitrary
+    g <- NU.UpdateNodeParamsGraph <$> arbitrary
+    t <- NU.UpdateNodeParamsTexts <$> arbitrary
+    b <- NU.UpdateNodeParamsBoard <$> arbitrary
+    elements [l,g,t,b]
+instance Arbitrary NU.Method where
+  arbitrary = elements [ minBound .. maxBound ]
+instance Arbitrary NU.Granularity where
+  arbitrary = elements [ minBound .. maxBound ]
+instance Arbitrary NU.Charts where
+  arbitrary = elements [ minBound .. maxBound ]
+instance Arbitrary NU.UpdateNodeConfigGraph where
+  arbitrary = do
+    methodGraphMetric        <- arbitrary
+    methodGraphClustering    <- arbitrary
+    methodGraphBridgeness    <- arbitrary
+    methodGraphEdgesStrength <- arbitrary
+    methodGraphNodeType1     <- arbitrary
+    methodGraphNodeType2     <- arbitrary
+    return $ NU.UpdateNodeConfigGraph methodGraphMetric
+                                      methodGraphClustering
+                                      methodGraphBridgeness
+                                      methodGraphEdgesStrength
+                                      methodGraphNodeType1
+                                      methodGraphNodeType2
+
 instance Arbitrary Ngrams.UpdateTableNgramsCharts where
   arbitrary = Ngrams.UpdateTableNgramsCharts <$> arbitrary   -- _utn_tab_type
                                              <*> arbitrary   -- _utn_list_id