Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
160
Issues
160
List
Board
Labels
Milestones
Merge Requests
14
Merge Requests
14
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
e578bc9c
Commit
e578bc9c
authored
May 28, 2024
by
Alfredo Di Napoli
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Derive generic clients
parent
65750c75
Changes
39
Hide whitespace changes
Inline
Side-by-side
Showing
39 changed files
with
217 additions
and
174 deletions
+217
-174
cabal.project
cabal.project
+2
-2
gargantext.cabal
gargantext.cabal
+3
-1
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+6
-5
Types.hs
src/Gargantext/API/Admin/Orchestrator/Types.hs
+3
-2
PolicyCheck.hs
src/Gargantext/API/Auth/PolicyCheck.hs
+7
-0
List.hs
src/Gargantext/API/Ngrams/List.hs
+3
-2
Types.hs
src/Gargantext/API/Ngrams/Types.hs
+7
-4
Node.hs
src/Gargantext/API/Node.hs
+1
-1
Contact.hs
src/Gargantext/API/Node/Contact.hs
+2
-1
Annuaire.hs
src/Gargantext/API/Node/Corpus/Annuaire.hs
+0
-11
New.hs
src/Gargantext/API/Node/Corpus/New.hs
+0
-27
Types.hs
src/Gargantext/API/Node/Document/Export/Types.hs
+4
-1
DocumentUpload.hs
src/Gargantext/API/Node/DocumentUpload.hs
+2
-1
DocumentsFromWriteNodes.hs
src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
+2
-1
File.hs
src/Gargantext/API/Node/File.hs
+10
-44
Types.hs
src/Gargantext/API/Node/File/Types.hs
+36
-0
FrameCalcUpload.hs
src/Gargantext/API/Node/FrameCalcUpload.hs
+2
-1
New.hs
src/Gargantext/API/Node/New.hs
+2
-9
Update.hs
src/Gargantext/API/Node/Update.hs
+2
-1
Routes.hs
src/Gargantext/API/Routes.hs
+8
-7
Named.hs
src/Gargantext/API/Routes/Named.hs
+2
-2
Annuaire.hs
src/Gargantext/API/Routes/Named/Annuaire.hs
+1
-1
Contact.hs
src/Gargantext/API/Routes/Named/Contact.hs
+1
-1
Corpus.hs
src/Gargantext/API/Routes/Named/Corpus.hs
+2
-2
Document.hs
src/Gargantext/API/Routes/Named/Document.hs
+2
-2
File.hs
src/Gargantext/API/Routes/Named/File.hs
+2
-2
FrameCalc.hs
src/Gargantext/API/Routes/Named/FrameCalc.hs
+1
-1
List.hs
src/Gargantext/API/Routes/Named/List.hs
+2
-2
Node.hs
src/Gargantext/API/Routes/Named/Node.hs
+2
-2
Table.hs
src/Gargantext/API/Routes/Named/Table.hs
+1
-1
Types.hs
src/Gargantext/API/Routes/Types.hs
+9
-2
Ngrams.hs
src/Gargantext/API/Server/Named/Ngrams.hs
+2
-1
Types.hs
src/Gargantext/API/Types.hs
+14
-6
stack.yaml
stack.yaml
+2
-2
Authentication.hs
test/Test/API/Authentication.hs
+1
-1
Routes.hs
test/Test/API/Routes.hs
+64
-18
Setup.hs
test/Test/API/Setup.hs
+1
-1
UpdateList.hs
test/Test/API/UpdateList.hs
+5
-5
Utils.hs
test/Test/Utils.hs
+1
-1
No files found.
cabal.project
View file @
e578bc9c
...
...
@@ -51,8 +51,8 @@ source-repository-package
source
-
repository
-
package
type
:
git
location
:
https
://
github
.
com
/
a
lpmestan
/
servant
-
job
.
git
tag
:
b4182487cfe479777c11ca19f3c0d47840b376f
6
location
:
https
://
github
.
com
/
a
dinapoli
/
servant
-
job
.
git
tag
:
74
a3296dfe1f0c4a3ade91336dcc689330e8415
6
source
-
repository
-
package
type
:
git
...
...
gargantext.cabal
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -136,5 +136,6 @@ type ScrapersEnv = JobEnv JobLog JobLog
type
ScraperAPI
=
AsyncJobsAPI
JobLog
ScraperInput
JobLog
------------------------------------------------------------------------
type
AsyncJobs
event
ctI
input
output
=
AsyncJobsAPI'
'U
n
safe
'S
a
fe
ctI
'[
J
SON
]
Maybe
event
input
output
data
AsyncJobs
event
ctI
input
output
mode
=
AsyncJobs
{
asyncJobsAPI'
::
mode
:-
AsyncJobsAPI'
'U
n
safe
'S
a
fe
ctI
'[
J
SON
]
Maybe
event
input
output
}
deriving
Generic
src/Gargantext/API/Auth/PolicyCheck.hs
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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_"
)
''
N
gramsRepoElement
-- 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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
'[
F
ormUrlEncoded
]
AnnuaireWithForm
JobLog
------------------------------------------------------------------------
addToAnnuaireWithForm
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
=>
AnnuaireId
...
...
src/Gargantext/API/Node/Corpus/New.hs
View file @
e578bc9c
...
...
@@ -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
'[
J
SON
]
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
'[
F
ormUrlEncoded
]
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
'[
F
ormUrlEncoded
]
NewWithFile
JobLog
addToCorpusWithFile
::
(
HasSettings
env
,
FlowCmdM
env
err
m
,
MonadJobStatus
m
)
=>
User
->
CorpusId
...
...
src/Gargantext/API/Node/Document/Export/Types.hs
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
'[
R
ESPONSE
]
(
Headers
'[
S
ervant
.
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
'[
S
ervant
.
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
'[
S
ervant
.
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
'[
F
ormUrlEncoded
]
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
0 → 100644
View file @
e578bc9c
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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
'[
F
ormUrlEncoded
]
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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
'[
J
SON
]
ForgotPasswordAsyncParams
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
J
SON
]
ForgotPasswordAsyncParams
JobLog
)
}
deriving
Generic
...
...
src/Gargantext/API/Routes/Named/Annuaire.hs
View file @
e578bc9c
...
...
@@ -18,5 +18,5 @@ newtype AddAnnuaireWithForm mode = AddAnnuaireWithForm
:>
"add"
:>
"form"
:>
"async"
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
AnnuaireWithForm
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
AnnuaireWithForm
JobLog
)
}
deriving
Generic
src/Gargantext/API/Routes/Named/Contact.hs
View file @
e578bc9c
...
...
@@ -26,5 +26,5 @@ data ContactAPI mode = ContactAPI
newtype
ContactAsyncAPI
mode
=
ContactAsyncAPI
{
addContactAsyncEp
::
mode
:-
AsyncJobs
JobLog
'[
J
SON
]
AddContactParams
JobLog
{
addContactAsyncEp
::
mode
:-
NamedRoutes
(
AsyncJobs
JobLog
'[
J
SON
]
AddContactParams
JobLog
)
}
deriving
Generic
src/Gargantext/API/Routes/Named/Corpus.hs
View file @
e578bc9c
...
...
@@ -32,7 +32,7 @@ newtype AddWithForm mode = AddWithForm
:>
"add"
:>
"form"
:>
"async"
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
NewWithForm
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
NewWithForm
JobLog
)
}
deriving
Generic
newtype
AddWithQuery
mode
=
AddWithQuery
...
...
@@ -40,5 +40,5 @@ newtype AddWithQuery mode = AddWithQuery
:>
"corpus"
:>
Capture
"corpus_id"
CorpusId
:>
"query"
:>
AsyncJobs
JobLog
'[
J
SON
]
WithQuery
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
J
SON
]
WithQuery
JobLog
)
}
deriving
Generic
src/Gargantext/API/Routes/Named/Document.hs
View file @
e578bc9c
...
...
@@ -37,7 +37,7 @@ data DocumentExportEndpoints mode = DocumentExportEndpoints
newtype
DocumentsFromWriteNodesAPI
mode
=
DocumentsFromWriteNodesAPI
{
docFromWriteNodesEp
::
mode
:-
Summary
" Documents from Write nodes."
:>
AsyncJobs
JobLog
'[
J
SON
]
Params
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
J
SON
]
Params
JobLog
)
}
deriving
Generic
...
...
@@ -46,5 +46,5 @@ newtype DocumentUploadAPI mode = DocumentUploadAPI
:>
"document"
:>
"upload"
:>
"async"
:>
AsyncJobs
JobLog
'[
J
SON
]
DocumentUpload
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
J
SON
]
DocumentUpload
JobLog
)
}
deriving
Generic
src/Gargantext/API/Routes/Named/File.hs
View file @
e578bc9c
...
...
@@ -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
'[
F
ormUrlEncoded
]
NewWithFile
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
NewWithFile
JobLog
)
}
deriving
Generic
src/Gargantext/API/Routes/Named/FrameCalc.hs
View file @
e578bc9c
...
...
@@ -17,6 +17,6 @@ newtype FrameCalcAPI mode = FrameCalcAPI
:>
"add"
:>
"framecalc"
:>
"async"
:>
AsyncJobs
JobLog
'[
J
SON
]
FrameCalcUpload
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
J
SON
]
FrameCalcUpload
JobLog
)
}
deriving
Generic
src/Gargantext/API/Routes/Named/List.hs
View file @
e578bc9c
...
...
@@ -40,7 +40,7 @@ newtype JSONAPI mode = JSONAPI
:>
"add"
:>
"form"
:>
"async"
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
WithJsonFile
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
WithJsonFile
JobLog
)
}
deriving
Generic
...
...
@@ -52,5 +52,5 @@ newtype CSVAPI mode = CSVAPI
:>
"add"
:>
"form"
:>
"async"
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
WithTextFile
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
WithTextFile
JobLog
)
}
deriving
Generic
src/Gargantext/API/Routes/Named/Node.hs
View file @
e578bc9c
...
...
@@ -133,7 +133,7 @@ newtype NodeNodeAPI a mode = NodeNodeAPI
newtype
PostNodeAsyncAPI
mode
=
PostNodeAsyncAPI
{
postNodeAsyncEp
::
mode
:-
Summary
"Post Node"
:>
"async"
:>
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
PostNode
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
F
ormUrlEncoded
]
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
'[
J
SON
]
UpdateNodeParams
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
J
SON
]
UpdateNodeParams
JobLog
)
}
deriving
Generic
...
...
src/Gargantext/API/Routes/Named/Table.hs
View file @
e578bc9c
...
...
@@ -107,5 +107,5 @@ data TableNgramsAsyncAPI mode = TableNgramsAsyncAPI
:>
"async"
:>
"charts"
:>
"update"
:>
AsyncJobs
JobLog
'[
J
SON
]
UpdateTableNgramsCharts
JobLog
:>
NamedRoutes
(
AsyncJobs
JobLog
'[
J
SON
]
UpdateTableNgramsCharts
JobLog
)
}
deriving
Generic
src/Gargantext/API/Routes/Types.hs
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -77,8 +77,8 @@
git
:
"
https://github.com/alpmestan/hmatrix.git"
subdirs
:
-
packages/base
-
commit
:
b4182487cfe479777c11ca19f3c0d47840b376f
6
git
:
"
https://github.com/a
lpmestan
/servant-job.git"
-
commit
:
74a3296dfe1f0c4a3ade91336dcc689330e8415
6
git
:
"
https://github.com/a
dinapoli
/servant-job.git"
subdirs
:
-
.
-
commit
:
bc6ca8058077b0b5702ea4b88bd4189cfcad267a
...
...
test/Test/API/Authentication.hs
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
{-# 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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
View file @
e578bc9c
...
...
@@ -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
)
...
...
Przemyslaw Kaminski
@cgenie
mentioned in commit
5660aec0
·
Oct 08, 2024
mentioned in commit
5660aec0
mentioned in commit 5660aec07ec5a0a0a5468f440092c1a8f57a864e
Toggle commit list
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment