Derive generic clients

cabal.project

@@ -51,8 +51,8 @@ source-repository-package
 
 source-repository-package
     type: git
-    location: https://github.com/alpmestan/servant-job.git
-    tag: b4182487cfe479777c11ca19f3c0d47840b376f6
+    location: https://github.com/adinapoli/servant-job.git
+    tag: 74a3296dfe1f0c4a3ade91336dcc689330e84156
 
 source-repository-package
     type: git

gargantext.cabal

@@ -133,6 +133,7 @@ library
       Gargantext.API.Node.Corpus.Types
       Gargantext.API.Node.Corpus.Update
       Gargantext.API.Node.File
+      Gargantext.API.Node.File.Types
       Gargantext.API.Node.Share
       Gargantext.API.Node.Share.Types
       Gargantext.API.Node.ShareURL
@@ -162,6 +163,7 @@ library
       Gargantext.API.Routes.Named.Tree
       Gargantext.API.Routes.Named.Viz
       Gargantext.API.Routes.Types
+      Gargantext.API.Types
       Gargantext.API.Viz.Types
       Gargantext.Core
       Gargantext.Core.Mail.Types
@@ -327,7 +329,6 @@ library
       Gargantext.API.Table
       Gargantext.API.Table.Types
       Gargantext.API.ThrowAll
-      Gargantext.API.Types
       Gargantext.Core.Ext.IMT
       Gargantext.Core.Ext.IMTUser
       Gargantext.Core.Flow.Ngrams
@@ -642,6 +643,7 @@ library
     , servant-server >= 0.18.3 && < 0.20
     , servant-swagger >= 1.2
     , servant-swagger-ui ^>= 0.3.5.3.5.0
+    , servant-swagger-ui-core >= 0.3.5
     , servant-xml-conduit >= 0.1.0.4
     , simple-reflect ^>= 0.3.3
     , singletons ^>= 2.7

src/Gargantext/API/Admin/Auth.hs

@@ -50,8 +50,10 @@ import Data.UUID (UUID, fromText, toText)
 import Data.UUID.V4 (nextRandom)
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
+import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
 import Gargantext.API.Admin.Types
 import Gargantext.API.Auth.PolicyCheck
+import Gargantext.API.Errors
 import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, _ServerError, GargM, IsGargServer)
 import Gargantext.Core.Mail (MailModel(..), mail)
 import Gargantext.Core.Mail.Types (mailSettings)
@@ -59,8 +61,8 @@ import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.User.New (guessUserName)
 import Gargantext.Database.Admin.Types.Node (NodeId(..))
-import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
 import Gargantext.Database.Admin.Types.Node (UserId)
+import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
 import Gargantext.Database.Query.Table.User
 import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
 import Gargantext.Database.Query.Tree.Root (getRoot)
@@ -70,11 +72,10 @@ import Gargantext.Prelude.Crypto.Auth qualified as Auth
 import Gargantext.Prelude.Crypto.Pass.User (gargPass)
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant
+import Servant.API.Generic ()
 import Servant.Auth.Server
-import Gargantext.API.Errors
-import qualified Gargantext.API.Routes.Named as Named
 import Servant.Server.Generic
-import Servant.API.Generic ()
+import qualified Gargantext.API.Routes.Named as Named
 
 ---------------------------------------------------
 
@@ -325,7 +326,7 @@ generateForgotPasswordUUID = do
 -- request, because the delay in email sending etc won't reveal to
 -- malicious users emails of our users in the db
 forgotPasswordAsync :: Named.ForgotPasswordAsyncAPI (AsServerT (GargM Env BackendInternalError))
-forgotPasswordAsync = Named.ForgotPasswordAsyncAPI $
+forgotPasswordAsync = Named.ForgotPasswordAsyncAPI $ AsyncJobs $
   serveJobsAPI ForgotPasswordJob $ \jHandle p -> forgotPasswordAsync' p jHandle
 
 forgotPasswordAsync' :: (FlowCmdM env err m, MonadJobStatus m)

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

@@ -136,5 +136,6 @@ type ScrapersEnv = JobEnv JobLog JobLog
 type ScraperAPI  = AsyncJobsAPI JobLog ScraperInput  JobLog
 
 ------------------------------------------------------------------------
-type AsyncJobs event ctI input output =
-  AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output
+data AsyncJobs event ctI input output mode = AsyncJobs
+  { asyncJobsAPI' :: mode :- AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output }
+  deriving Generic

src/Gargantext/API/Auth/PolicyCheck.hs

@@ -39,6 +39,7 @@ import Servant.Ekg
 import Servant.Server.Internal.Delayed
 import Servant.Server.Internal.DelayedIO
 import qualified Servant.Swagger as Swagger
+import Servant.Client.Core
 
 -------------------------------------------------------------------------------
 -- Types
@@ -196,6 +197,12 @@ instance HasEndpoint sub => HasEndpoint (PolicyChecked sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
 
+instance HasClient m sub => HasClient m (PolicyChecked sub) where
+  type Client m (PolicyChecked sub) = AccessPolicyManager -> Client m sub
+  clientWithRoute m _ req _mgr = clientWithRoute m (Proxy :: Proxy sub) req
+
+  hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
+
 -------------------------------------------------------------------------------
 -- Utility functions
 -------------------------------------------------------------------------------

src/Gargantext/API/Ngrams/List.hs

@@ -28,6 +28,7 @@ import Data.Text (concat, pack, splitOn)
 import Data.Vector (Vector)
 import Data.Vector qualified as Vec
 import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
+import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Ngrams (setListNgrams)
 import Gargantext.API.Ngrams.List.Types
@@ -106,7 +107,7 @@ getCsv lId = do
 
 ------------------------------------------------------------------------
 jsonPostAsync :: Named.JSONAPI (AsServerT (GargM Env BackendInternalError))
-jsonPostAsync = Named.JSONAPI $ \lId ->
+jsonPostAsync = Named.JSONAPI $ \lId -> AsyncJobs $
   serveJobsAPI UpdateNgramsListJobJSON $ \jHandle f ->
     postAsyncJSON lId (_wjf_data f) jHandle
 
@@ -147,7 +148,7 @@ csvAPI = csvPostAsync
 
 ------------------------------------------------------------------------
 csvPostAsync :: Named.CSVAPI (AsServerT (GargM Env BackendInternalError))
-csvPostAsync = Named.CSVAPI $ \lId ->
+csvPostAsync = Named.CSVAPI $ \lId -> AsyncJobs $
   serveJobsAPI UpdateNgramsListJobCSV $ \jHandle f -> do
     case ngramsListFromCSVData (_wtf_data f) of
       Left err         -> serverError $ err500 { errReasonPhrase = err }

src/Gargantext/API/Ngrams/Types.hs

@@ -49,7 +49,7 @@ import Gargantext.Prelude hiding (IsString, hash, from, replace, to)
 import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
 import Gargantext.Utils.Servant (CSV, ZIP)
 import Gargantext.Utils.Zip (zipContentsPure)
-import Servant ( FromHttpApiData(parseUrlPiece), ToHttpApiData(toUrlPiece), Required, Strict, QueryParam', MimeRender(.. ))
+import Servant ( FromHttpApiData(parseUrlPiece), ToHttpApiData(toUrlPiece), Required, Strict, QueryParam', MimeRender(.. ), MimeUnrender(..))
 import Servant.Job.Utils (jsonOptions)
 import Test.QuickCheck (elements, frequency)
 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
@@ -94,7 +94,7 @@ instance ToJSONKey TabType where
   toJSONKey = genericToJSONKey defaultJSONKeyOptions
 
 newtype MSet a = MSet (Map a ())
-  deriving stock (Eq, Ord, Show, Generic)
+  deriving stock (Eq, Ord, Show, Read, Generic)
   deriving newtype (Arbitrary, Semigroup, Monoid)
   deriving anyclass (ToExpr)
 
@@ -128,7 +128,7 @@ instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
 
 ------------------------------------------------------------------------
 newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text }
-  deriving (Ord, Eq, Show, Generic)
+  deriving (Ord, Eq, Show, Read, Generic)
   deriving newtype (ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable, NFData, FromField, ToField)
   deriving anyclass (ToExpr)
 instance IsHashable NgramsTerm where
@@ -159,7 +159,7 @@ data NgramsRepoElement = NgramsRepoElement
   , _nre_parent      :: !(Maybe NgramsTerm)
   , _nre_children    :: !(MSet NgramsTerm)
   }
-  deriving (Ord, Eq, Show, Generic)
+  deriving (Ord, Eq, Show, Read, Generic)
 deriveJSON (unPrefix "_nre_") ''NgramsRepoElement
 -- TODO
 -- if ngrams & not size => size
@@ -811,6 +811,9 @@ instance MimeRender ZIP NgramsListZIP where
   mimeRender _ nlz@(NgramsListZIP { .. }) =
     zipContentsPure (T.unpack $ nlzFileName nlz) (encode _nlz_nl)
 
+instance MimeUnrender ZIP NgramsListZIP where
+  mimeUnrender _ _ = Left "mimeUnrender for NgramsListZIP not supported"
+
 
 
 --

src/Gargantext/API/Node.hs

@@ -258,7 +258,7 @@ genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
   , moveAPI            = Named.MoveAPI $ moveNode userRootId targetNode
   , unpublishEp        = Share.unPublish targetNode
   , fileAPI            = Named.FileAPI $ fileApi targetNode
-  , fileAsyncAPI       = Named.FileAsyncAPI $ fileAsyncApi authenticatedUser targetNode
+  , fileAsyncAPI       = fileAsyncApi authenticatedUser targetNode
   , dfwnAPI            = DFWN.api authenticatedUser targetNode
   , documentUploadAPI  = DocumentUpload.api targetNode
   }

src/Gargantext/API/Node/Contact.hs

@@ -23,6 +23,7 @@ module Gargantext.API.Node.Contact
 import Conduit ( yield )
 import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(AuthenticatedUser) )
 import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
+import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Node ( nodeNodeAPI )
@@ -51,7 +52,7 @@ contactAPI authUser@(AuthenticatedUser userNodeId _userUserId) cid = Named.Conta
 
 ----------------------------------------------------------------------
 api_async :: User -> NodeId -> Named.ContactAsyncAPI (AsServerT (GargM Env BackendInternalError))
-api_async u nId = Named.ContactAsyncAPI $
+api_async u nId = Named.ContactAsyncAPI $ AsyncJobs $
   serveJobsAPI AddContactJob $ \jHandle p ->
     addContact u nId p jHandle
 

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

@@ -17,7 +17,6 @@ module Gargantext.API.Node.Corpus.Annuaire
 import Control.Lens hiding (elements)
 import Data.Aeson
 import Data.Swagger
-import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Node.Corpus.New.Types qualified as NewTypes
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
@@ -51,16 +50,6 @@ instance ToJSON AnnuaireWithForm where
 instance ToSchema AnnuaireWithForm where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
 
-------------------------------------------------------------------------
-
-type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint"
-   :> "annuaire"
-   :> Capture "annuaire_id" AnnuaireId
-   :> "add"
-   :> "form"
-   :> "async"
-   :> AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog
-
 ------------------------------------------------------------------------
 addToAnnuaireWithForm :: (FlowCmdM env err m, MonadJobStatus m)
                     => AnnuaireId

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

@@ -28,7 +28,6 @@ import Data.Swagger ( ToSchema(..) )
 import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
 import EPO.API.Client.Types qualified as EPO
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
 import Gargantext.API.Node.Corpus.New.Types ( FileFormat(..), FileType(..) )
@@ -61,7 +60,6 @@ import Gargantext.Prelude
 import Gargantext.Prelude.Config (gc_max_docs_parsers)
 import Gargantext.System.Logging ( logLocM, LogLevel(..) )
 import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(..))
-import Servant ( JSON, type (:>), FormUrlEncoded, Capture, Summary )
 import Test.QuickCheck.Arbitrary (Arbitrary(..))
 
 ------------------------------------------------------------------------
@@ -132,13 +130,6 @@ instance ToSchema ApiInfo
 info :: ApiInfo
 info = ApiInfo API.externalAPIs
 
-------------------------------------------------------------------------
-type AddWithQuery = Summary "Add with Query to corpus endpoint"
-   :> "corpus"
-     :> Capture "corpus_id" CorpusId
-   :> "query"
-     :> AsyncJobs JobLog '[JSON] WithQuery JobLog
-
 {-
 type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
    :> "corpus"
@@ -228,14 +219,6 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
           $(logLocM) ERROR (T.pack $ show err) -- log the full error
           markFailed (Just err) jobHandle
 
-type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
-   :> "corpus"
-     :> Capture "corpus_id" CorpusId
-   :> "add"
-   :> "form"
-   :> "async"
-     :> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
-
 addToCorpusWithForm :: ( FlowCmdM env err m
                        , MonadJobStatus m
                        , HasNodeStoryImmediateSaver env
@@ -342,16 +325,6 @@ addToCorpusWithFile cid input filetype logStatus = do
                           }
 -}
 
-
-
-type AddWithFile = Summary "Add with FileUrlEncoded to corpus endpoint"
-   :> "corpus"
-     :> Capture "corpus_id" CorpusId
-   :> "add"
-   :> "file"
-   :> "async"
-     :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
-
 addToCorpusWithFile :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
                     => User
                     -> CorpusId

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

@@ -27,7 +27,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Utils.Servant (ZIP)
 import Gargantext.Utils.Zip (zipContentsPureWithLastModified)
 import Protolude
-import Servant (MimeRender(..))
+import Servant (MimeRender(..), MimeUnrender(..))
 
 
 -- | Document Export
@@ -118,3 +118,6 @@ dezFileName (DocumentExportZIP { .. }) = "GarganText_DocsList-" <> show _dez_doc
 instance MimeRender ZIP DocumentExportZIP where
   mimeRender _ dexpz@(DocumentExportZIP { .. }) =
     zipContentsPureWithLastModified (T.unpack $ dezFileName dexpz) (encode _dez_dexp) _dez_last_modified
+
+instance MimeUnrender ZIP DocumentExportZIP where
+  mimeUnrender _ _ = Left "mimeUnrender for DocumentExportZIP not supported"

src/Gargantext/API/Node/DocumentUpload.hs

@@ -19,6 +19,7 @@ module Gargantext.API.Node.DocumentUpload where
 import Control.Lens (view)
 import Data.Text qualified as T
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
+import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Node.DocumentUpload.Types
 import Gargantext.API.Prelude ( GargM )
@@ -39,7 +40,7 @@ import Servant.Server.Generic (AsServerT)
 
 
 api :: NodeId -> Named.DocumentUploadAPI (AsServerT (GargM Env BackendInternalError))
-api nId = Named.DocumentUploadAPI $
+api nId = Named.DocumentUploadAPI $ AsyncJobs $
   serveJobsAPI UploadDocumentJob $ \jHandle q -> do
       documentUploadAsync nId q jHandle
 

src/Gargantext/API/Node/DocumentsFromWriteNodes.hs

@@ -21,6 +21,7 @@ import Data.List qualified as List
 import Data.Text qualified as T
 import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser, auth_node_id, auth_user_id )
 import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
+import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
@@ -50,7 +51,7 @@ api :: AuthenticatedUser
     -- ^ The logged-in user
     -> NodeId
     -> Named.DocumentsFromWriteNodesAPI (AsServerT (GargM Env BackendInternalError))
-api authenticatedUser nId = Named.DocumentsFromWriteNodesAPI $
+api authenticatedUser nId = Named.DocumentsFromWriteNodesAPI $ AsyncJobs $
   serveJobsAPI DocumentFromWriteNodeJob $ \jHandle p ->
     documentsFromWriteNodes authenticatedUser nId p jHandle
 

src/Gargantext/API/Node/File.hs

@@ -17,19 +17,17 @@ Portability : POSIX
 
 module Gargantext.API.Node.File where
 
-import Data.ByteString qualified as BS
-import Data.ByteString.Lazy qualified as BSL
 import Data.MIME.Types qualified as DMT
-import Data.Swagger (ToSchema(..))
 import Data.Text qualified as T
 import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser, auth_user_id )
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
+import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
+import Gargantext.API.Node.File.Types
 import Gargantext.API.Node.Types ( NewWithFile(NewWithFile) )
-import Gargantext.API.Prelude ( GargM, GargServer )
-import Gargantext.Core.Types (TODO)
+import Gargantext.API.Prelude ( GargM )
+import Gargantext.API.Routes.Named.File qualified as Named
 import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) )
@@ -40,40 +38,14 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
-import Network.HTTP.Media qualified as M
 import Servant
+import Servant.Server.Generic (AsServerT)
 
-data RESPONSE deriving Typeable
-
-instance Accept RESPONSE where
-  contentType _ = "text" M.// "*"
-
-instance MimeRender RESPONSE BSResponse where
-  mimeRender _ (BSResponse val) = BSL.fromStrict $ val
-
-type FileApi = Summary "File download"
-            :> "download"
-            :> Get '[RESPONSE] (Headers '[Servant.Header "Content-Type" Text] BSResponse)
-
-instance MimeUnrender RESPONSE BSResponse where
-  mimeUnrender _ lbs = Right $ BSResponse (BSL.toStrict lbs)
-
-fileApi :: NodeId -> GargServer FileApi
+fileApi :: (HasSettings env, FlowCmdM env err m)
+        => NodeId
+        -> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
 fileApi nId = fileDownload nId
 
-newtype Contents = Contents BS.ByteString
-
-instance GargDB.ReadFile Contents where
-  readFile' fp = do
-    c <- BS.readFile fp
-    pure $ Contents c
-
-newtype BSResponse = BSResponse BS.ByteString
-  deriving (Generic)
-
-instance ToSchema BSResponse  where
-  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
-
 fileDownload :: (HasSettings env, FlowCmdM env err m)
              => NodeId
              -> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
@@ -102,17 +74,11 @@ fileDownload nId = do
 
   -- let settings = embeddedSettings [("", "hello")]
   -- Tagged $ staticApp settings
-
-type FileAsyncApi = Summary "File Async Api"
-                 :> "file"
-                 :> "add"
-                 :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
-
 fileAsyncApi :: AuthenticatedUser
              -- ^ The logged-in user
              -> NodeId
-             -> ServerT FileAsyncApi (GargM Env BackendInternalError)
-fileAsyncApi authenticatedUser nId =
+             -> Named.FileAsyncAPI (AsServerT (GargM Env BackendInternalError))
+fileAsyncApi authenticatedUser nId = Named.FileAsyncAPI $ AsyncJobs $
   serveJobsAPI AddFileJob $ \jHandle i ->
     addWithFile authenticatedUser nId i jHandle
 

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

+
+module Gargantext.API.Node.File.Types where
+
+import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BSL
+import Data.Swagger (ToSchema(..))
+import Gargantext.Core.Types (TODO)
+import Gargantext.Database.GargDB qualified as GargDB
+import Gargantext.Prelude
+import Network.HTTP.Media qualified as M
+import Servant
+
+data RESPONSE deriving Typeable
+
+instance Accept RESPONSE where
+  contentType _ = "text" M.// "*"
+
+instance MimeRender RESPONSE BSResponse where
+  mimeRender _ (BSResponse val) = BSL.fromStrict $ val
+
+instance MimeUnrender RESPONSE BSResponse where
+  mimeUnrender _ lbs = Right $ BSResponse (BSL.toStrict lbs)
+
+newtype Contents = Contents BS.ByteString
+
+instance GargDB.ReadFile Contents where
+  readFile' fp = do
+    c <- BS.readFile fp
+    pure $ Contents c
+
+newtype BSResponse = BSResponse BS.ByteString
+  deriving (Generic)
+
+instance ToSchema BSResponse  where
+  declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
+

src/Gargantext/API/Node/FrameCalcUpload.hs

@@ -20,6 +20,7 @@ import Data.ByteString.UTF8 qualified as BSU8
 import Data.Text qualified as T
 import Gargantext.API.Admin.Auth.Types ( auth_node_id, AuthenticatedUser )
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
+import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Node.Corpus.New (addToCorpusWithForm)
 import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..))
@@ -43,7 +44,7 @@ import Servant.Server.Generic (AsServerT)
 
 
 api :: AuthenticatedUser -> NodeId -> Named.FrameCalcAPI (AsServerT (GargM Env BackendInternalError))
-api authenticatedUser nId = Named.FrameCalcAPI $
+api authenticatedUser nId = Named.FrameCalcAPI $ AsyncJobs $
   serveJobsAPI UploadFrameCalcJob $ \jHandle p ->
     frameCalcUploadAsync authenticatedUser nId p jHandle
 

src/Gargantext/API/Node/New.hs

@@ -23,7 +23,7 @@ module Gargantext.API.Node.New
 import Control.Lens hiding (elements, Empty)
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
+import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs (..))
 import Gargantext.API.Errors.Types
 import Gargantext.API.Node.New.Types
 import Gargantext.API.Prelude
@@ -35,7 +35,6 @@ import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Prelude
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
-import Servant
 import Servant.Server.Generic (AsServerT)
 
 ------------------------------------------------------------------------
@@ -49,19 +48,13 @@ postNode authenticatedUser pId (PostNode nodeName nt) = do
   let userId = authenticatedUser ^. auth_user_id
   mkNodeWithParent nt (Just pId) userId nodeName
 
-------------------------------------------------------------------------
-type PostNodeAsync = Summary "Post Node"
-   :> "async"
-   :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
-
-
 postNodeAsyncAPI
   :: AuthenticatedUser
   -- ^ The logged-in user
   -> NodeId
   -- ^ The target node
   -> Named.PostNodeAsyncAPI (AsServerT (GargM Env BackendInternalError))
-postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $
+postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
   serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync authenticatedUser nId p jHandle
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Update.hs

@@ -18,6 +18,7 @@ module Gargantext.API.Node.Update
 import Control.Lens (view)
 import Data.Set qualified as Set
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
+import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Metrics qualified as Metrics
@@ -47,7 +48,7 @@ import Servant.Server.Generic (AsServerT)
 
 ------------------------------------------------------------------------
 api :: NodeId -> Named.UpdateAPI (AsServerT (GargM Env BackendInternalError))
-api nId = Named.UpdateAPI $
+api nId = Named.UpdateAPI $ AsyncJobs $
   serveJobsAPI UpdateNodeJob $ \jHandle p ->
     updateNode nId p jHandle
 

src/Gargantext/API/Routes.hs

@@ -24,6 +24,7 @@ module Gargantext.API.Routes
 import Control.Lens (view)
 import Data.Validity
 import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
+import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
 import Gargantext.API.Errors.Types
 import Gargantext.API.Node.Corpus.Annuaire qualified as Annuaire
 import Gargantext.API.Node.Corpus.New qualified as New
@@ -52,7 +53,7 @@ waitAPI n = do
 ----------------------------------------
 
 addCorpusWithQuery :: User -> Named.AddWithQuery (AsServerT (GargM Env BackendInternalError))
-addCorpusWithQuery user = Named.AddWithQuery $ \cid ->
+addCorpusWithQuery user = Named.AddWithQuery $ \cid -> AsyncJobs $
   serveJobsAPI AddCorpusQueryJob $ \jHandle q -> do
     limit <- view $ hasConfig . gc_max_docs_scrapers
     New.addToCorpusWithQuery user cid q (Just $ fromIntegral limit) jHandle
@@ -62,19 +63,19 @@ addCorpusWithQuery user = Named.AddWithQuery $ \cid ->
       -}
 
 addCorpusWithForm :: User -> Named.AddWithForm (AsServerT (GargM Env BackendInternalError))
-addCorpusWithForm user = Named.AddWithForm $ \cid ->
+addCorpusWithForm user = Named.AddWithForm $ \cid -> AsyncJobs $
   serveJobsAPI AddCorpusFormJob $ \jHandle i -> do
     -- /NOTE(adinapoli)/ Track the initial steps outside 'addToCorpusWithForm', because it's
     -- called in a few places, and the job status might be different between invocations.
     markStarted 3 jHandle
     New.addToCorpusWithForm user cid i jHandle
 
-addCorpusWithFile :: User -> ServerT New.AddWithFile (GargM Env BackendInternalError)
-addCorpusWithFile user cid =
-  serveJobsAPI AddCorpusFileJob $ \jHandle i ->
-    New.addToCorpusWithFile user cid i jHandle
+--addCorpusWithFile :: User -> ServerT Named.AddWithFile (GargM Env BackendInternalError)
+--addCorpusWithFile user cid =
+--  serveJobsAPI AddCorpusFileJob $ \jHandle i ->
+--    New.addToCorpusWithFile user cid i jHandle
 
 addAnnuaireWithForm :: Named.AddAnnuaireWithForm (AsServerT (GargM Env BackendInternalError))
-addAnnuaireWithForm = Named.AddAnnuaireWithForm $ \cid ->
+addAnnuaireWithForm = Named.AddAnnuaireWithForm $ \cid -> AsyncJobs $
   serveJobsAPI AddAnnuaireFormJob $ \jHandle i ->
     Annuaire.addToAnnuaireWithForm cid i jHandle

src/Gargantext/API/Routes/Named.hs

@@ -53,7 +53,7 @@ newtype SwaggerAPI mode = SwaggerAPI
 
 
 newtype BackEndAPI mode = BackEndAPI {
-  mkBackendAPI :: mode :- NamedRoutes (MkBackEndAPI (GargAPIVersion GargAPI'))
+   backendAPI' :: mode :- NamedRoutes (MkBackEndAPI (GargAPIVersion GargAPI'))
   } deriving Generic
 
 
@@ -96,7 +96,7 @@ data ForgotPasswordAPI mode = ForgotPasswordAPI
 
 data ForgotPasswordAsyncAPI mode = ForgotPasswordAsyncAPI
   { forgotPasswordAsyncEp :: mode :- Summary "Forgot password asnc"
-                                  :> AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog
+                                  :> NamedRoutes (AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog)
   } deriving Generic
 
 

src/Gargantext/API/Routes/Named/Annuaire.hs

@@ -18,5 +18,5 @@ newtype AddAnnuaireWithForm mode = AddAnnuaireWithForm
                           :> "add"
                           :> "form"
                           :> "async"
-                          :> AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog
+                          :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog)
   } deriving Generic

src/Gargantext/API/Routes/Named/Contact.hs

@@ -26,5 +26,5 @@ data ContactAPI mode = ContactAPI
 
 
 newtype ContactAsyncAPI mode = ContactAsyncAPI
-  { addContactAsyncEp :: mode :- AsyncJobs JobLog '[JSON] AddContactParams JobLog
+  { addContactAsyncEp :: mode :- NamedRoutes (AsyncJobs JobLog '[JSON] AddContactParams JobLog)
   } deriving Generic

src/Gargantext/API/Routes/Named/Corpus.hs

@@ -32,7 +32,7 @@ newtype AddWithForm mode = AddWithForm
                           :> "add"
                           :> "form"
                           :> "async"
-                          :> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
+                          :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog)
   } deriving Generic
 
 newtype AddWithQuery mode = AddWithQuery
@@ -40,5 +40,5 @@ newtype AddWithQuery mode = AddWithQuery
                            :> "corpus"
                            :> Capture "corpus_id" CorpusId
                            :> "query"
-                           :> AsyncJobs JobLog '[JSON] WithQuery JobLog
+                           :> NamedRoutes (AsyncJobs JobLog '[JSON] WithQuery JobLog)
   } deriving Generic

src/Gargantext/API/Routes/Named/Document.hs

@@ -37,7 +37,7 @@ data DocumentExportEndpoints mode = DocumentExportEndpoints
 
 newtype DocumentsFromWriteNodesAPI mode = DocumentsFromWriteNodesAPI
   { docFromWriteNodesEp :: mode :- Summary " Documents from Write nodes."
-                                :> AsyncJobs JobLog '[JSON] Params JobLog
+                                :> NamedRoutes (AsyncJobs JobLog '[JSON] Params JobLog)
   } deriving Generic
 
 
@@ -46,5 +46,5 @@ newtype DocumentUploadAPI mode = DocumentUploadAPI
                              :> "document"
                              :> "upload"
                              :> "async"
-                             :> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
+                             :> NamedRoutes (AsyncJobs JobLog '[JSON] DocumentUpload JobLog)
   } deriving Generic

src/Gargantext/API/Routes/Named/File.hs

@@ -9,9 +9,9 @@ module Gargantext.API.Routes.Named.File (
 import Data.Text (Text)
 import GHC.Generics
 import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Node.File
 import Gargantext.API.Node.Types
 import Servant
+import Gargantext.API.Node.File.Types
 
 data FileAPI mode = FileAPI
   { fileDownloadEp :: mode :- Summary "File download"
@@ -24,6 +24,6 @@ data FileAsyncAPI mode = FileAsyncAPI
   { addFileAsyncEp :: mode :- Summary "File Async Api"
                            :> "file"
                            :> "add"
-                           :> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
+                           :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog)
   } deriving Generic
 

src/Gargantext/API/Routes/Named/FrameCalc.hs

@@ -17,6 +17,6 @@ newtype FrameCalcAPI mode = FrameCalcAPI
                               :> "add"
                               :> "framecalc"
                               :> "async"
-                              :> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
+                              :> NamedRoutes (AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog)
   } deriving Generic
 

src/Gargantext/API/Routes/Named/List.hs

@@ -40,7 +40,7 @@ newtype JSONAPI mode = JSONAPI
                              :> "add"
                              :> "form"
                              :> "async"
-                             :> AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog
+                             :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog)
   } deriving Generic
 
 
@@ -52,5 +52,5 @@ newtype CSVAPI mode = CSVAPI
                             :> "add"
                             :> "form"
                             :> "async"
-                            :> AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog
+                            :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog)
   } deriving Generic

src/Gargantext/API/Routes/Named/Node.hs

@@ -133,7 +133,7 @@ newtype NodeNodeAPI a mode = NodeNodeAPI
 newtype PostNodeAsyncAPI mode = PostNodeAsyncAPI
   { postNodeAsyncEp :: mode :- Summary "Post Node"
                             :> "async"
-                            :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
+                            :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog)
   } deriving Generic
 
 
@@ -146,7 +146,7 @@ newtype CatAPI mode =  CatAPI
 
 newtype UpdateAPI mode = UpdateAPI
   { updateNodeEp :: mode :- Summary " Update node according to NodeType params"
-                         :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
+                         :> NamedRoutes (AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog)
   } deriving Generic
 
 

src/Gargantext/API/Routes/Named/Table.hs

@@ -107,5 +107,5 @@ data TableNgramsAsyncAPI mode = TableNgramsAsyncAPI
                                       :> "async"
                                       :> "charts"
                                       :> "update"
-                                      :> AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog
+                                      :> NamedRoutes (AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog)
   } deriving Generic

src/Gargantext/API/Routes/Types.hs

@@ -5,12 +5,13 @@ module Gargantext.API.Routes.Types where
 import Data.List qualified as L
 import Data.Proxy
 import Gargantext.API.Errors
+import Network.Wai
 import Prelude
+import Servant.Client
 import Servant.Ekg
 import Servant.Server
-import Servant.Server.Internal.DelayedIO
 import Servant.Server.Internal.Delayed
-import Network.Wai
+import Servant.Server.Internal.DelayedIO
 
 data WithCustomErrorScheme a
 
@@ -30,3 +31,9 @@ instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx
 instance HasEndpoint sub => HasEndpoint (WithCustomErrorScheme sub) where
   getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
   enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
+
+instance HasClient m sub => HasClient m (WithCustomErrorScheme sub) where
+  type Client m (WithCustomErrorScheme sub) = GargErrorScheme -> Client m sub
+  clientWithRoute m _ req _mgr = clientWithRoute m (Proxy :: Proxy sub) req
+
+  hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl

src/Gargantext/API/Server/Named/Ngrams.hs

@@ -11,6 +11,7 @@ import Data.Set qualified as Set
 import Gargantext.API.Admin.Auth (withNamedAccess)
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, PathId (..))
 import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
 import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Metrics qualified as Metrics
@@ -65,7 +66,7 @@ getTableNgramsVersion _nId _tabType listId = currentVersion listId
 
 
 apiNgramsAsync :: NodeId -> Named.TableNgramsAsyncAPI (AsServerT (GargM Env BackendInternalError))
-apiNgramsAsync _dId = Named.TableNgramsAsyncAPI $
+apiNgramsAsync _dId = Named.TableNgramsAsyncAPI $ AsyncJobs $
   serveJobsAPI TableNgramsJob $ \jHandle i -> withTracer (printDebug "tableNgramsPostChartsAsync") jHandle $
     \jHandle' -> tableNgramsPostChartsAsync i jHandle'
 

src/Gargantext/API/Types.hs

@@ -10,23 +10,27 @@ Portability : POSIX
 -}
 
 {-# OPTIONS_GHC -fprint-potential-instances #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Gargantext.API.Types where
 
 import Data.Aeson
-import qualified Data.ByteString.Lazy.Char8 as BS8
 import Data.Either (Either(..))
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Text (Text)
-import qualified Data.Text.Encoding as E
 import Data.Typeable
+import Gargantext.API.Ngrams.Types ()
+import Gargantext.API.Node.Document.Export.Types ()
+import Gargantext.Core.Viz.Graph.Types (Graph(..))
 import Network.HTTP.Media ((//), (/:))
 import Prelude (($))
+import Servant.API.ContentTypes ( Accept(..) , MimeRender(..) , MimeUnrender(..) )
+import Servant.HTML.Blaze qualified as Blaze
+import Servant.Swagger.UI.Core
+import Servant.XML.Conduit qualified as S
+import qualified Data.ByteString.Lazy.Char8 as BS8
+import qualified Data.Text.Encoding as E
 import qualified Prelude
-import Servant
-  ( Accept(..)
-  , MimeRender(..)
-  , MimeUnrender(..) )
 
 data HTML deriving (Typeable)
 instance Accept HTML where
@@ -41,3 +45,7 @@ instance MimeUnrender HTML Text where
     mimeUnrender _ bs = Right $ E.decodeUtf8 $ BS8.toStrict bs
 instance {-# OVERLAPPABLE #-} ToJSON a => MimeRender HTML a where
   mimeRender _ = encode
+instance MimeUnrender Blaze.HTML (SwaggerUiHtml dir api) where
+  mimeUnrender _ bs = Right (SwaggerUiHtml $ E.decodeUtf8 $ BS8.toStrict bs)
+instance MimeUnrender S.XML Graph where
+  mimeUnrender _ = eitherDecode

stack.yaml

@@ -77,8 +77,8 @@
   git: "https://github.com/alpmestan/hmatrix.git"
   subdirs:
   - packages/base
-- commit: b4182487cfe479777c11ca19f3c0d47840b376f6
-  git: "https://github.com/alpmestan/servant-job.git"
+- commit: 74a3296dfe1f0c4a3ade91336dcc689330e84156
+  git: "https://github.com/adinapoli/servant-job.git"
   subdirs:
   - .
 - commit: bc6ca8058077b0b5702ea4b88bd4189cfcad267a

test/Test/API/Authentication.hs

@@ -40,7 +40,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
 
     -- testing scenarios start here
     describe "GET /api/v1.0/version" $ do
-      let version_api = gargVersionEp genericClient
+      let version_api = gargVersionEp . gargAPIVersion . mkBackEndAPI $ genericClient
       it "requires no auth and returns the current version" $ \((_testEnv, port), _) -> do
         result <- runClientM version_api (clientEnv port)
         case result of

test/Test/API/Routes.hs

 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ViewPatterns #-}
 
 
 module Test.API.Routes where
 
 import Fmt (Builder, (+|), (|+))
-import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse)
+import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, Token)
 import Gargantext.API.Ngrams.Types ( NgramsTable, NgramsTablePatch, OrderBy, TabType, Versioned, VersionedWithCount )
 import Gargantext.API.Routes.Named
+import Gargantext.API.Routes.Named.Table
+import Gargantext.Core.Types (ListId, NodeId)
 import Gargantext.Core.Types.Main (ListType)
 import Gargantext.Core.Types.Query (Limit, MaxSize, MinSize, Offset)
 import Gargantext.Prelude
 import Network.Wai.Handler.Warp (Port)
 import Servant.Client (ClientM)
 import Servant.Client.Generic ( genericClient, AsClientT )
-import Gargantext.API.Routes.Named.Table
-import Gargantext.Core.Types (ListId)
-
+import Gargantext.API.Types () -- MimeUnrender instances
+import Gargantext.API.Errors
+import Gargantext.API.Routes.Named.Private hiding (tableNgramsAPI)
+import Gargantext.API.Routes.Named.Node
+import qualified Servant.Auth.Client as S
+import qualified Data.Text.Encoding as TE
 
 -- This is for requests made by http.client directly to hand-crafted URLs    
 curApi :: Builder
@@ -28,15 +34,26 @@ mkUrl _port urlPiece =
   "/api/" +| curApi |+ urlPiece
 
 
+-- | The client for the full API. It also serves as a \"proof\" that our
+-- whole API has all the required instances to be used in a client.
+clientRoutes :: API (AsClientT ClientM)
+clientRoutes = genericClient
+
 
 -- This is for Servant.Client requests
 auth_api :: AuthRequest -> ClientM AuthResponse
-auth_api = authEp cliRoutes
-  where
-    cliRoutes :: AuthAPI (AsClientT ClientM)
-    cliRoutes = genericClient @AuthAPI
+auth_api = clientRoutes & apiWithCustomErrorScheme
+                        & ($ GES_new)
+                        & backendAPI
+                        & backendAPI'
+                        & mkBackEndAPI
+                        & gargAPIVersion
+                        & gargAuthAPI
+                        & authEp
 
-table_ngrams_get_api :: TabType
+table_ngrams_get_api :: Token
+                     -> NodeId
+                     -> TabType
                      -> ListId
                      -> Limit
                      -> Maybe Offset
@@ -46,16 +63,45 @@ table_ngrams_get_api :: TabType
                      -> Maybe OrderBy
                      -> Maybe Text
                      -> ClientM (VersionedWithCount NgramsTable)
-table_ngrams_get_api = getNgramsTableEp cliRoutes
-  where
-    cliRoutes :: TableNgramsApiGet (AsClientT ClientM)
-    cliRoutes = genericClient @(TableNgramsApiGet)
+table_ngrams_get_api (toServantToken -> token) nodeId =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ nodeId)
+               & tableNgramsAPI
+               & tableNgramsGetAPI
+               & getNgramsTableEp
+
+toServantToken :: Token -> S.Token
+toServantToken = S.Token . TE.encodeUtf8
 
-table_ngrams_put_api :: TabType
+table_ngrams_put_api :: Token
+                     -> NodeId
+                     -> TabType
                      -> ListId
                      -> Versioned NgramsTablePatch
                      -> ClientM (Versioned NgramsTablePatch)
-table_ngrams_put_api = putNgramsTableEp cliRoutes
-  where
-    cliRoutes :: TableNgramsApiPut (AsClientT ClientM)
-    cliRoutes = genericClient @TableNgramsApiPut
+table_ngrams_put_api (toServantToken -> token) nodeId =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ nodeId)
+               & tableNgramsAPI
+               & tableNgramsPutAPI
+               & putNgramsTableEp

test/Test/API/Setup.hs

@@ -17,7 +17,7 @@ import Gargantext.Core.NodeStory
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow
 import Gargantext.Database.Action.User.New
-import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
+import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Trigger.Init
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Prelude

test/Test/API/UpdateList.hs

@@ -134,9 +134,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
             clientEnv <- liftIO $ authenticatedServantClient port token
 
             listId <- uploadJSONList port token cId
-            
+
             let checkNgrams expected = do
-                  eng <- liftIO $ runClientM (table_ngrams_get_api APINgrams.Terms listId 10 Nothing (Just MapTerm) Nothing Nothing Nothing Nothing) clientEnv
+                  eng <- liftIO $ runClientM (table_ngrams_get_api token cId APINgrams.Terms listId 10 Nothing (Just MapTerm) Nothing Nothing Nothing Nothing) clientEnv
                   case eng of
                     Left err -> fail (show err)
                     Right r ->
@@ -144,7 +144,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
                                                      , mSetToList $ nt ^. ne_children ))
                                              (r ^. vc_data . _NgramsTable) in
                       liftIO $ Set.fromList real `shouldBe` Set.fromList expected
-            
+
             -- The #313 error is about importedTerm being duplicated
             -- in a specific case
 
@@ -155,7 +155,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
                            , NgramsReplace { _patch_old = Nothing
                                            , _patch_new = Just nre } )
                       ]
-            _ <- liftIO $ runClientM (table_ngrams_put_api APINgrams.Terms listId (Versioned 1 $ NgramsTablePatch $ fst patch)) clientEnv
+            _ <- liftIO $ runClientM (table_ngrams_put_api token cId APINgrams.Terms listId (Versioned 1 $ NgramsTablePatch $ fst patch)) clientEnv
 
             -- check that new term is added (with no parent)
             checkNgrams [ (newTerm, [])
@@ -166,7 +166,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
                                  ( newTerm
                                  , toNgramsPatch [importedTerm] )
                                ]
-            _ <- liftIO $ runClientM (table_ngrams_put_api APINgrams.Terms listId (Versioned 32 $ NgramsTablePatch $ fst patchChildren)) clientEnv
+            _ <- liftIO $ runClientM (table_ngrams_put_api token cId APINgrams.Terms listId (Versioned 32 $ NgramsTablePatch $ fst patchChildren)) clientEnv
 
             -- check that new term is parent of old one
             checkNgrams [ (newTerm, [importedTerm]) ]

test/Test/Utils.hs

@@ -114,7 +114,7 @@ containsJSON expected = MatchBody matcher
 
 authenticatedServantClient :: Int -> T.Text -> IO ClientEnv
 authenticatedServantClient port token = do
-  baseUrl <- parseBaseUrl "http://localhost"
+  baseUrl <- parseBaseUrl "http://0.0.0.0"
   manager <- newManager defaultManagerSettings
   let requestAddToken url req =
           defaultMakeClientRequest url $ addHeader hAuthorization ("Bearer " <> token)