Skip to content

haskell-gargantext
haskell-gargantext
Verified Commit 85353a92 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
1 Browse files
Options

Merge branch 'dev' into 341-dev-websockets

parents 671aa21b 319a5c26
Pipeline #6196 failed with stages
          in 66 minutes and 26 seconds
          Expand all Hide whitespace changes
          Inline Side-by-side
          Showing with 2171 additions and 2708 deletions
          CHANGELOG.md
          View file @ 85353a92
          ## Version 0.0.7.1.6
          * [BACK][REFACT][Consider integrating Servant named routes (#271)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/271)
          * [FRONT][FIX] Double Option in form
          ## Version 0.0.7.1.5.5
          * [BACK][FIX][`nodeErrorToFrontendError` contains an `undefined` (#346)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/346)
          * [FRONT][FIX][[Tree perfs] When the tree is opening: reduce API calls or replace with lighter calls (#670)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/670)
          ## Version 0.0.7.1.5.4
          * [BACK][FIX][[Docs TSV export/import] Check and maintain consistency between export and import formats (#345)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/345)
          ......
          bin/gargantext-central-exchange/Main.hs
          View file @ 85353a92
          ......@@ -52,7 +52,7 @@ wsServer = do
          gClient :: IO ()
          gClient = do
          withSocket Push $ \s -> do
          _ <- connect s (tcp://localhost:" <> show cePort)
          _ <- connect s ("tcp://localhost:" <> show cePort)
          -- let str = C.unwords (take 10 $ repeat "hello")
          let str = "{\"type\": \"update_tree_first_level\", \"node_id\": -1}"
          C.putStrLn $ C.pack "sending: " <> str
          ......
          bin/gargantext-invitations/Main.hs
          View file @ 85353a92
          ......@@ -24,7 +24,8 @@ import Gargantext.Database.Prelude (CmdRandom)
          import Gargantext.Prelude
          import Gargantext.Prelude.Config (readConfig)
          import Prelude (read)
          import qualified Gargantext.API.Node.Share as Share
          import Gargantext.API.Node.Share.Types qualified as Share
          import Gargantext.API.Node.Share qualified as Share
          main :: IO ()
          main = do
          ......
          bin/update-project-dependencies
          View file @ 85353a92
          ......@@ -18,8 +18,8 @@ fi
          # with the `sha256sum` result calculated on the `cabal.project` and
          # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
          # cache can kick in.
          expected_cabal_project_hash="0d3f7f5beed88c1afe95e0df8a91080440ba59049f3610bf2343132635038d22"
          expected_cabal_project_freeze_hash="9b2cac3a02e9b129bd80253fc407782bf10c7ed62ed21be41c720d30ed17ef53"
          expected_cabal_project_hash="75954432d1b867597b6eff606d22b36e53a18b283464c9c9d309af231a694d6b"
          expected_cabal_project_freeze_hash="09930a2fa36e4325d46e5d069595d300c6017472f405f8ac67158377816d132a"
          cabal --store-dir=$STORE_DIR v2-build --dry-run
          cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
          ......
          cabal.project
          View file @ 85353a92
          ......@@ -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
          ......
          cabal.project.freeze
          View file @ 85353a92
          ......@@ -499,7 +499,7 @@ constraints: any.Cabal ==3.8.1.0,
          any.servant-multipart ==0.12.1,
          any.servant-multipart-api ==0.12.1,
          any.servant-server ==0.20,
          any.servant-swagger ==1.1.11,
          any.servant-swagger ==1.2,
          any.servant-swagger-ui ==0.3.5.5.0.0,
          any.servant-swagger-ui-core ==0.3.5,
          any.servant-xml-conduit ==0.1.0.4,
          ......
          gargantext.cabal
          View file @ 85353a92
          ......@@ -5,7 +5,7 @@ cabal-version: 3.4
          -- see: https://github.com/sol/hpack
          name: gargantext
          version: 0.0.7.1.5.4
          version: 0.0.7.1.6
          synopsis: Search, map, share
          description: Please see README.md
          category: Data
          ......@@ -113,6 +113,7 @@ library
          Gargantext.API.Admin.Settings.CORS
          Gargantext.API.Admin.Types
          Gargantext.API.Auth.PolicyCheck
          Gargantext.API.Count.Types
          Gargantext.API.Dev
          Gargantext.API.Errors
          Gargantext.API.Errors.Class
          ......@@ -132,18 +133,23 @@ 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
          Gargantext.API.Node.Types
          Gargantext.API.Node.Update
          Gargantext.API.Node.Update.Types
          Gargantext.API.Prelude
          Gargantext.API.Routes
          Gargantext.API.Routes.Named
          Gargantext.API.Routes.Named.Annuaire
          Gargantext.API.Routes.Named.Contact
          Gargantext.API.Routes.Named.Context
          Gargantext.API.Routes.Named.Corpus
          Gargantext.API.Routes.Named.Count
          Gargantext.API.Routes.Named.Document
          Gargantext.API.Routes.Named.EKG
          Gargantext.API.Routes.Named.File
          Gargantext.API.Routes.Named.FrameCalc
          Gargantext.API.Routes.Named.List
          ......@@ -157,12 +163,15 @@ 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.AsyncUpdates
          Gargantext.Core.AsyncUpdates.CentralExchange
          Gargantext.Core.AsyncUpdates.CentralExchange.Types
          Gargantext.Core.AsyncUpdates.Constants
          Gargantext.Core.AsyncUpdates.Dispatcher
          Gargantext.Core.AsyncUpdates.Dispatcher.Types
          Gargantext.Core.Mail.Types
          Gargantext.Core.Methods.Similarities
          Gargantext.Core.Methods.Similarities.Conditional
          ......@@ -293,6 +302,7 @@ library
          Gargantext.API.Metrics
          Gargantext.API.Ngrams.NgramsTree
          Gargantext.API.Node.Contact
          Gargantext.API.Node.Contact.Types
          Gargantext.API.Node.Corpus.Annuaire
          Gargantext.API.Node.Corpus.Export
          Gargantext.API.Node.Corpus.Export.Types
          ......@@ -304,17 +314,27 @@ library
          Gargantext.API.Node.Phylo.Export
          Gargantext.API.Node.Phylo.Export.Types
          Gargantext.API.Node.DocumentUpload
          Gargantext.API.Node.DocumentUpload.Types
          Gargantext.API.Node.DocumentsFromWriteNodes
          Gargantext.API.Node.DocumentsFromWriteNodes.Types
          Gargantext.API.Node.FrameCalcUpload
          Gargantext.API.Node.FrameCalcUpload.Types
          Gargantext.API.Node.Get
          Gargantext.API.Node.New
          Gargantext.API.Public
          Gargantext.API.Node.New.Types
          Gargantext.API.Public.Types
          Gargantext.API.Search
          Gargantext.API.Server
          Gargantext.API.Search.Types
          Gargantext.API.Server.Named
          Gargantext.API.Server.Named.EKG
          Gargantext.API.Server.Named.Ngrams
          Gargantext.API.Server.Named.Private
          Gargantext.API.Server.Named.Public
          Gargantext.API.Server.Named.Viz
          Gargantext.API.Swagger
          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
          ......@@ -629,8 +649,9 @@ library
          , servant-job >= 0.2.0.0
          , servant-multipart ^>= 0.12.1
          , servant-server >= 0.18.3 && < 0.20
          , servant-swagger ^>= 1.1.10
          , servant-swagger >= 1.2
          , servant-swagger-ui ^>= 0.3.5.3.5.0
          , servant-swagger-ui-core >= 0.3.5
          , servant-websockets >= 2.0.0 && < 2.1
          , servant-xml-conduit >= 0.1.0.4
          , simple-reflect ^>= 0.3.3
          ......
          src/Gargantext/API.hs
          View file @ 85353a92
          ......@@ -46,10 +46,11 @@ import Gargantext.API.Admin.EnvTypes (Env, Mode(..))
          import Gargantext.API.Admin.Settings (newEnv)
          import Gargantext.API.Admin.Settings.CORS
          import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings)
          import Gargantext.API.EKG
          import Gargantext.API.Routes.Named.EKG
          import Gargantext.API.Middleware (logStdoutDevSanitised)
          import Gargantext.API.Routes
          import Gargantext.API.Server (server)
          import Gargantext.API.Routes.Named (API)
          import Gargantext.API.Server.Named (server)
          -- import Gargantext.API.Server.Named.EKG
          import Gargantext.Core.AsyncUpdates.Constants qualified as AUConstants
          import Gargantext.Database.Prelude qualified as DB
          import Gargantext.Prelude hiding (putStrLn)
          ......@@ -93,7 +94,8 @@ portRouteInfo port = do
          putStrLn $ " - Swagger UI (API documentation)...........: " <> "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
          putStrLn $ " - Playground GraphQL (API documentation)...: " <> "http://localhost:" <> toUrlPiece port <> "/gql"
          putStrLn $ " - Central exchange.........................: " <> "nanomsg://localhost:" <> show AUConstants.cePort
          putStrLn $ " - Dispatcher internal......................: " <> "namosg://localhost:" <> show AUConstants.dispatcherInternalPort
          putStrLn $ " - Dispatcher internal......................: " <> "nanomsg://localhost:" <> show AUConstants.dispatcherInternalPort
          putStrLn $ " - WebSocket address........................: " <> "ws://localhost:" <> toUrlPiece port <> "/ws"
          putStrLn "=========================================================================================================="
          -- | Stops the gargantext server and cancels all the periodic actions
          ......@@ -169,12 +171,13 @@ makeGargMiddleware crsSettings mode = do
          makeApp :: Env -> IO Application
          makeApp env = do
          serv <- server env
          pure $ serveWithContext api cfg serv
          pure $ serveWithContext api cfg (server env)
          -- (ekgStore, ekgMid) <- newEkgStore api
          -- ekgDir <- (</> "ekg-assets") <$> getDataDir
          -- pure $ ekgMid $ serveWithContext apiWithEkg cfg
          -- (ekgServer ekgDir ekgStore :<|> serv)
          -- (WithEkg { ekgAPI = ekgServer ekgDir ekgStore
          -- , wrappedAPI = server env
          -- })
          where
          cfg :: Servant.Context AuthContext
          cfg = env ^. settings . jwtSettings
          ......@@ -182,12 +185,15 @@ makeApp env = do
          :. EmptyContext
          ---------------------------------------------------------------------
          api :: Proxy API
          api :: Proxy (NamedRoutes API)
          api = Proxy
          apiWithEkg :: Proxy (EkgAPI :<|> API)
          apiWithEkg = Proxy
          apiGarg :: Proxy GargAPI
          apiGarg = Proxy
          ---------------------------------------------------------------------
          data WithEkg api mode = WithEkg
          { ekgAPI :: mode :- NamedRoutes EkgAPI
          , wrappedAPI :: mode :- NamedRoutes api
          } deriving Generic
          apiWithEkg :: Proxy (NamedRoutes (WithEkg API))
          apiWithEkg = Proxy
          src/Gargantext/API/Admin/Auth.hs
          View file @ 85353a92
          ......@@ -27,41 +27,42 @@ And you have the main viz
          {-# LANGUAGE MonoLocalBinds #-}
          {-# LANGUAGE ScopedTypeVariables #-}
          {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE TypeApplications #-}
          module Gargantext.API.Admin.Auth
          ( auth
          , withPolicy
          , withPolicyT
          , withNamedPolicyT
          , forgotPassword
          , forgotPasswordAsync
          , withAccess
          , ForgotPasswordAPI
          , withNamedAccess
          , ForgotPasswordAsyncParams
          , ForgotPasswordAsyncAPI
          )
          where
          import Control.Lens (view, (#))
          import Data.Aeson
          import Data.Swagger (ToSchema(..))
          import Data.Text qualified as Text
          import Data.Text.Lazy.Encoding qualified as LE
          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 (JobLog(..), AsyncJobs)
          import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
          import Gargantext.API.Admin.Types
          import Gargantext.API.Auth.PolicyCheck
          import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, GargServer, _ServerError, GargM)
          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)
          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)
          ......@@ -71,8 +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 Servant.Server.Generic
          import qualified Gargantext.API.Routes.Named as Named
          ---------------------------------------------------
          ......@@ -163,10 +166,23 @@ withAccess p _ ur id = hoistServer p f
          f :: forall a. m a -> m a
          f = withAccessM ur id
          withNamedAccess :: forall env err m routes.
          ( IsGargServer env err m
          , HasServer (NamedRoutes routes) '[]
          )
          => AuthenticatedUser
          -> PathId
          -> routes (AsServerT m)
          -> routes (AsServerT m)
          withNamedAccess ur pathId = hoistServer (Proxy @(NamedRoutes routes)) f
          where
          f :: forall a. m a -> m a
          f = withAccessM ur pathId
          -- | Given the 'AuthenticatedUser', a policy check and a function that returns an @a@,
          -- it runs the underlying policy check to ensure that the resource is returned only to
          -- who is entitled to see it.
          withPolicy :: GargServerC env BackendInternalError m
          withPolicy :: IsGargServer env BackendInternalError m
          => AuthenticatedUser
          -> BoolExpr AccessCheck
          -> m a
          ......@@ -179,8 +195,21 @@ withPolicy ur checks m mgr = case mgr of
          Allow -> m
          Deny err -> throwError $ InternalServerError $ err
          -- FIXME(adn) the types are wrong.
          withNamedPolicyT :: forall env m routes.
          ( IsGargServer env BackendInternalError m
          , HasServer (NamedRoutes routes) '[]
          )
          => AuthenticatedUser
          -> BoolExpr AccessCheck
          -> routes (AsServerT m)
          -> AccessPolicyManager
          -> routes (AsServerT m)
          withNamedPolicyT ur checks m mgr =
          hoistServer (Proxy @(NamedRoutes routes)) (\n -> withPolicy ur checks n mgr) m
          withPolicyT :: forall env m api. (
          GargServerC env BackendInternalError m
          IsGargServer env BackendInternalError m
          , HasServer api '[]
          )
          => Proxy api
          ......@@ -202,26 +231,12 @@ User can invite User in Team as NodeNode only if Team in his parents.
          All users can access to the Team folder as if they were owner.
          -}
          newtype ForgotPasswordAsyncParams =
          ForgotPasswordAsyncParams { email :: Text }
          deriving (Generic, Show)
          instance FromJSON ForgotPasswordAsyncParams where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON ForgotPasswordAsyncParams where
          toJSON = genericToJSON defaultOptions
          instance ToSchema ForgotPasswordAsyncParams
          type ForgotPasswordAPI = Summary "Forgot password POST API"
          :> ReqBody '[JSON] ForgotPasswordRequest
          :> Post '[JSON] ForgotPasswordResponse
          :<|> Summary "Forgot password GET API"
          :> QueryParam "uuid" Text
          :> Get '[JSON] ForgotPasswordGet
          forgotPassword :: GargServer ForgotPasswordAPI
          forgotPassword :: IsGargServer env err m => Named.ForgotPasswordAPI (AsServerT m)
          -- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
          forgotPassword = forgotPasswordPost :<|> forgotPasswordGet
          forgotPassword = Named.ForgotPasswordAPI
          { forgotPasswordPostEp = forgotPasswordPost
          , forgotPasswordGetEp = forgotPasswordGet
          }
          forgotPasswordPost :: (CmdCommon env)
          => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
          ......@@ -310,11 +325,8 @@ generateForgotPasswordUUID = do
          -- NOTE THe async endpoint is better for the "forget password"
          -- request, because the delay in email sending etc won't reveal to
          -- malicious users emails of our users in the db
          type ForgotPasswordAsyncAPI = Summary "Forgot password asnc"
          :> AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog
          forgotPasswordAsync :: ServerT ForgotPasswordAsyncAPI (GargM Env BackendInternalError)
          forgotPasswordAsync =
          forgotPasswordAsync :: Named.ForgotPasswordAsyncAPI (AsServerT (GargM Env BackendInternalError))
          forgotPasswordAsync = Named.ForgotPasswordAsyncAPI $ AsyncJobs $
          serveJobsAPI ForgotPasswordJob $ \jHandle p -> forgotPasswordAsync' p jHandle
          forgotPasswordAsync' :: (FlowCmdM env err m, MonadJobStatus m)
          ......
          src/Gargantext/API/Admin/Auth/Types.hs
          View file @ 85353a92
          ......@@ -11,9 +11,36 @@ Portability : POSIX
          {-# LANGUAGE TemplateHaskell #-}
          module Gargantext.API.Admin.Auth.Types
          where
          import qualified Data.Aeson.TH as JSON
          ( -- * Types
          AuthRequest(..)
          , AuthResponse(..)
          , Token
          , TreeId
          , CheckAuth(..)
          , AuthenticatedUser(..)
          , AuthContext
          , AuthenticationError(..)
          , PathId(..)
          , Email
          , Password
          , ForgotPasswordRequest(..)
          , ForgotPasswordResponse(..)
          , ForgotPasswordAsyncParams(..)
          , ForgotPasswordGet(..)
          -- * Lenses
          , auth_node_id
          , auth_user_id
          , authRes_token
          , authRes_tree_id
          , authRes_user_id
          -- * Combinators
          ) where
          import Crypto.JWT qualified as Jose
          import Data.Aeson.TH qualified as JSON
          import Data.Aeson.Types (genericParseJSON, defaultOptions, genericToJSON)
          import Data.List (tail)
          import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
          import Gargantext.Core.Types.Individu (Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
          ......@@ -23,7 +50,6 @@ import Gargantext.Prelude hiding (reverse)
          import Servant.Auth.Server
          import Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
          import qualified Crypto.JWT as Jose
          ---------------------------------------------------
          ......@@ -106,6 +132,15 @@ data ForgotPasswordGet = ForgotPasswordGet {_fpGet_password :: Password}
          instance ToSchema ForgotPasswordGet where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpGet_")
          newtype ForgotPasswordAsyncParams =
          ForgotPasswordAsyncParams { email :: Text }
          deriving (Generic, Show)
          instance FromJSON ForgotPasswordAsyncParams where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON ForgotPasswordAsyncParams where
          toJSON = genericToJSON defaultOptions
          instance ToSchema ForgotPasswordAsyncParams
          --
          -- Lenses
          --
          ......
          src/Gargantext/API/Admin/EnvTypes.hs
          View file @ 85353a92
          ......@@ -36,8 +36,8 @@ import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.API.Admin.Types
          import Gargantext.API.Errors.Types
          import Gargantext.API.Job
          import Gargantext.API.Prelude (GargM)
          import Gargantext.Core.AsyncUpdates.Dispatcher (Dispatcher)
          import Gargantext.API.Prelude (GargM, IsGargServer)
          import Gargantext.Core.AsyncUpdates.Dispatcher.Types (Dispatcher)
          import Gargantext.Core.Mail.Types (HasMail, mailSettings)
          import Gargantext.Core.NLP (NLPServerMap, HasNLPServer(..))
          import Gargantext.Core.NodeStory
          ......@@ -327,3 +327,6 @@ instance HasMail DevEnv where
          instance HasNLPServer DevEnv where
          nlpServer = dev_env_nlp
          instance IsGargServer Env BackendInternalError (GargM Env BackendInternalError)
          src/Gargantext/API/Admin/Orchestrator/Types.hs
          View file @ 85353a92
          ......@@ -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
          View file @ 85353a92
          ......@@ -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/Context.hs
          View file @ 85353a92
          ......@@ -23,28 +23,27 @@ import Prelude
          import Data.Aeson (FromJSON, ToJSON)
          import Servant
          import Gargantext.API.Admin.Auth (withAccess)
          import Gargantext.API.Admin.Auth (withNamedAccess)
          import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser)
          import Gargantext.API.Prelude
          import Gargantext.Database.Admin.Types.Node
          import Gargantext.Database.Prelude (JSONB)
          import Gargantext.Database.Query.Table.Context
          import Servant.Server.Generic (AsServerT)
          import Gargantext.API.Routes.Named.Context qualified as Named
          -------------------------------------------------------------------
          -- TODO use Context instead of Node
          type ContextAPI a = Get '[JSON] (Node a)
          ------------------------------------------------------------------------
          -- TODO NodeAPI -> ContextAPI
          contextAPI :: forall proxy a.
          ( JSONB a
          , FromJSON a
          , ToJSON a
          ) => proxy a
          -> AuthenticatedUser
          -> ContextId
          -> GargServer (ContextAPI a)
          contextAPI p uId id' = withAccess (Proxy :: Proxy (ContextAPI a)) Proxy uId (PathNode $ contextId2NodeId id') contextAPI'
          contextAPI :: ( IsGargServer env err m
          , JSONB a
          , FromJSON a
          , ToJSON a )
          => Proxy a
          -> AuthenticatedUser
          -> ContextId
          -> Named.ContextAPI a (AsServerT m)
          contextAPI p uId id' =
          withNamedAccess uId (PathNode $ contextId2NodeId id') contextAPI'
          where
          contextAPI' :: GargServer (ContextAPI a)
          contextAPI' = getContextWith id' p
          contextAPI' = Named.ContextAPI $ getContextWith id' p
          src/Gargantext/API/Count.hs
          View file @ 85353a92
          ......@@ -17,143 +17,17 @@ Count API part of Gargantext.
          {-# LANGUAGE DeriveAnyClass #-}
          module Gargantext.API.Count (
          CountAPI
          , Scraper(..)
          , QueryBool(..)
          , Query(..)
          , Message(..)
          , Code
          , Error
          , Errors
          , Counts(..)
          , Count(..)
          -- * functions
          , count
          , scrapers
          countAPI
          ) where
          import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
          import Data.Text (pack)
          import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
          import Gargantext.API.Count.Types
          import Gargantext.API.Routes.Named.Count qualified as Named
          import Gargantext.Prelude
          import Servant (JSON, Post)
          import Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary (Arbitrary(..))
          import Servant.Server.Generic (AsServerT)
          -----------------------------------------------------------------------
          -- TODO-ACCESS: CanCount
          -- TODO-EVENTS: No events as this is a read only query.
          type CountAPI = Post '[JSON] Counts
          -----------------------------------------------------------------------
          data Scraper = Pubmed | Hal | IsTex | Isidore
          deriving (Eq, Show, Generic, Enum, Bounded)
          scrapers :: [Scraper]
          scrapers = [minBound..maxBound]
          instance FromJSON Scraper
          instance ToJSON Scraper
          instance Arbitrary Scraper where
          arbitrary = elements scrapers
          instance ToSchema Scraper
          -----------------------------------------------------------------------
          data QueryBool = QueryBool Text
          deriving (Eq, Show, Generic)
          queries :: [QueryBool]
          queries = [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
          --queries = [QueryBool (pack "(X + X') * (Y + Y') - (Z + Z')")]
          instance Arbitrary QueryBool where
          arbitrary = elements queries
          instance FromJSON QueryBool
          instance ToJSON QueryBool
          instance ToSchema QueryBool
          -----------------------------------------------------------------------
          data Query = Query { query_query :: QueryBool
          , query_name :: Maybe [Scraper]
          }
          deriving (Eq, Show, Generic)
          instance FromJSON Query
          instance ToJSON Query
          instance Arbitrary Query where
          arbitrary = elements [ Query q (Just n)
          | q <- queries
          , n <- take 10 $ permutations scrapers
          ]
          instance ToSchema Query where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
          -----------------------------------------------------------------------
          type Code = Integer
          type Error = Text
          type Errors = [Error]
          -----------------------------------------------------------------------
          data Message = Message Code Errors
          deriving (Eq, Show, Generic)
          toMessage :: [(Code, Errors)] -> [Message]
          toMessage = map (\(c,err) -> Message c err)
          messages :: [Message]
          messages = toMessage $ [ (400, ["Ill formed query "])
          , (300, ["API connexion error "])
          , (300, ["Internal Gargantext Error "])
          ] <> take 10 ( repeat (200, [""]))
          instance Arbitrary Message where
          arbitrary = elements messages
          instance ToSchema Message
          -----------------------------------------------------------------------
          data Counts = Counts { results :: [Either Message Count]
          } deriving (Eq, Show, Generic)
          instance Arbitrary Counts where
          arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
          , Right (Count IsTex (Just 150))
          , Right (Count Hal (Just 150))
          ]
          ]
          instance ToSchema Counts
          -----------------------------------------------------------------------
          data Count = Count { count_name :: Scraper
          , count_count :: Maybe Int
          }
          deriving (Eq, Show, Generic)
          instance ToSchema Count where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
          --instance Arbitrary Count where
          -- arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
          -----------------------------------------------------------------------
          count :: Monad m => Query -> m Counts
          count _ = undefined
          --
          -- JSON instances
          --
          instance FromJSON Message
          instance ToJSON Message
          $(deriveJSON (unPrefix "count_") ''Count)
          instance FromJSON Counts
          instance ToJSON Counts
          countAPI :: Monad m => Query -> Named.CountAPI (AsServerT m)
          countAPI _ = Named.CountAPI undefined
          src/Gargantext/API/Count/Types.hs 0 → 100644
          View file @ 85353a92
          {-# LANGUAGE TemplateHaskell #-}
          module Gargantext.API.Count.Types (
          Scraper(..)
          , QueryBool(..)
          , Query(..)
          , Message(..)
          , Code
          , Error
          , Errors
          , Counts(..)
          , Count(..)
          -- * functions
          , scrapers
          ) where
          import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
          import Data.Text (pack)
          import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
          import Gargantext.Prelude
          import Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary (Arbitrary(..))
          -----------------------------------------------------------------------
          data Scraper = Pubmed | Hal | IsTex | Isidore
          deriving (Eq, Show, Generic, Enum, Bounded)
          scrapers :: [Scraper]
          scrapers = [minBound..maxBound]
          instance FromJSON Scraper
          instance ToJSON Scraper
          instance Arbitrary Scraper where
          arbitrary = elements scrapers
          instance ToSchema Scraper
          -----------------------------------------------------------------------
          data QueryBool = QueryBool Text
          deriving (Eq, Show, Generic)
          queries :: [QueryBool]
          queries = [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
          --queries = [QueryBool (pack "(X + X') * (Y + Y') - (Z + Z')")]
          instance Arbitrary QueryBool where
          arbitrary = elements queries
          instance FromJSON QueryBool
          instance ToJSON QueryBool
          instance ToSchema QueryBool
          -----------------------------------------------------------------------
          data Query = Query { query_query :: QueryBool
          , query_name :: Maybe [Scraper]
          }
          deriving (Eq, Show, Generic)
          instance FromJSON Query
          instance ToJSON Query
          instance Arbitrary Query where
          arbitrary = elements [ Query q (Just n)
          | q <- queries
          , n <- take 10 $ permutations scrapers
          ]
          instance ToSchema Query where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
          -----------------------------------------------------------------------
          type Code = Integer
          type Error = Text
          type Errors = [Error]
          -----------------------------------------------------------------------
          data Message = Message Code Errors
          deriving (Eq, Show, Generic)
          toMessage :: [(Code, Errors)] -> [Message]
          toMessage = map (\(c,err) -> Message c err)
          messages :: [Message]
          messages = toMessage $ [ (400, ["Ill formed query "])
          , (300, ["API connexion error "])
          , (300, ["Internal Gargantext Error "])
          ] <> take 10 ( repeat (200, [""]))
          instance Arbitrary Message where
          arbitrary = elements messages
          instance ToSchema Message
          -----------------------------------------------------------------------
          data Counts = Counts { results :: [Either Message Count]
          } deriving (Eq, Show, Generic)
          instance Arbitrary Counts where
          arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
          , Right (Count IsTex (Just 150))
          , Right (Count Hal (Just 150))
          ]
          ]
          instance ToSchema Counts
          -----------------------------------------------------------------------
          data Count = Count { count_name :: Scraper
          , count_count :: Maybe Int
          }
          deriving (Eq, Show, Generic)
          instance ToSchema Count where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
          --instance Arbitrary Count where
          -- arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
          --
          -- JSON instances
          --
          instance FromJSON Message
          instance ToJSON Message
          $(deriveJSON (unPrefix "count_") ''Count)
          instance FromJSON Counts
          instance ToJSON Counts
          src/Gargantext/API/Errors.hs
          View file @ 85353a92
          ......@@ -128,8 +128,6 @@ nodeErrorToFrontendError ne = case ne of
          -> mkFrontendErrShow FE_node_root_not_found
          NoCorpusFound
          -> mkFrontendErrShow FE_node_corpus_not_found
          NoUserFound _ur
          -> undefined
          NodeCreationFailed reason
          -> case reason of
          UserParentAlreadyExists pId uId
          ......@@ -175,7 +173,6 @@ showAsServantJSONErr :: BackendInternalError -> ServerError
          showAsServantJSONErr (InternalNodeError err@(NoListFound {})) = err404 { errBody = JSON.encode err }
          showAsServantJSONErr (InternalNodeError err@NoRootFound{}) = err404 { errBody = JSON.encode err }
          showAsServantJSONErr (InternalNodeError err@NoCorpusFound) = err404 { errBody = JSON.encode err }
          showAsServantJSONErr (InternalNodeError err@NoUserFound{}) = err404 { errBody = JSON.encode err }
          showAsServantJSONErr (InternalNodeError err@(DoesNotExist {})) = err404 { errBody = JSON.encode err }
          showAsServantJSONErr (InternalServerError err) = err
          showAsServantJSONErr a = err500 { errBody = JSON.encode a }
          src/Gargantext/API/Members.hs
          View file @ 85353a92
          ......@@ -10,23 +10,18 @@ Portability : POSIX
          module Gargantext.API.Members where
          import Gargantext.API.Admin.EnvTypes (Env)
          import Gargantext.API.Errors.Types
          import Gargantext.API.Prelude
          import Gargantext.API.Routes.Named.Private qualified as Named
          import Gargantext.Database.Action.Share (membersOf)
          import Gargantext.Database.Admin.Types.Node (NodeType(NodeTeam))
          import Gargantext.Database.Prelude (CmdCommon)
          import Gargantext.Database.Query.Table.Node (getNodesIdWithType)
          import Gargantext.Prelude
          import Servant
          import Servant.Server.Generic (AsServerT)
          type MembersAPI = Get '[JSON] [Text]
          members :: IsGargServer err env m => Named.MembersAPI (AsServerT m)
          members = Named.MembersAPI getMembers
          members :: ServerT MembersAPI (GargM Env BackendInternalError)
          members = getMembers
          getMembers :: (CmdCommon env) =>
          GargM env BackendInternalError [Text]
          getMembers :: IsGargServer err env m => m [Text]
          getMembers = do
          teamNodeIds <- getNodesIdWithType NodeTeam
          m <- concatMapM membersOf teamNodeIds
          ......
          src/Gargantext/API/Metrics.hs
          View file @ 85353a92
          ......@@ -25,7 +25,8 @@ import Data.Vector (Vector)
          import Gargantext.API.HashedResponse
          import Gargantext.API.Ngrams.NgramsTree
          import Gargantext.API.Ngrams.Types
          import Gargantext.API.Prelude (GargServer)
          import Gargantext.API.Prelude (IsGargServer)
          import Gargantext.API.Routes.Named.Metrics qualified as Named
          import Gargantext.Core.NodeStory (HasNodeStory)
          import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
          import Gargantext.Core.Types (CorpusId, ListId, ListType(..))
          ......@@ -43,28 +44,15 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
          import Gargantext.Database.Schema.Node (node_hyperdata)
          import Gargantext.Prelude hiding (hash)
          import Servant
          import Servant.Server.Generic (AsServerT)
          -------------------------------------------------------------
          -- | Scatter metrics API
          type ScatterAPI = Summary "SepGen IncExc metrics"
          :> QueryParam "list" ListId
          :> QueryParamR "ngramsType" TabType
          :> QueryParam "limit" Limit
          :> Get '[JSON] (HashedResponse Metrics)
          :<|> Summary "Scatter update"
          :> QueryParam "list" ListId
          :> QueryParamR "ngramsType" TabType
          :> QueryParam "limit" Limit
          :> Post '[JSON] ()
          :<|> "hash" :> Summary "Scatter Hash"
          :> QueryParam "list" ListId
          :> QueryParamR "ngramsType" TabType
          :> Get '[JSON] Text
          scatterApi :: NodeId -> GargServer ScatterAPI
          scatterApi id' = getScatter id'
          :<|> updateScatter id'
          :<|> getScatterHash id'
          scatterApi :: IsGargServer err env m => NodeId -> Named.ScatterAPI (AsServerT m)
          scatterApi id' = Named.ScatterAPI
          { sepGenEp = getScatter id'
          , scatterUpdateEp = updateScatter id'
          , scatterHashEp = getScatterHash id'
          }
          getScatter :: HasNodeStory env err m
          => CorpusId
          ......@@ -139,27 +127,12 @@ getScatterHash cId maybeListId tabType = do
          -------------------------------------------------------------
          -- | Chart metrics API
          type ChartApi = Summary " Chart API"
          :> QueryParam "from" UTCTime
          :> QueryParam "to" UTCTime
          :> QueryParam "list" ListId
          :> QueryParamR "ngramsType" TabType
          :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
          :<|> Summary "Chart update"
          :> QueryParam "list" ListId
          :> QueryParamR "ngramsType" TabType
          :> QueryParam "limit" Limit
          :> Post '[JSON] ()
          :<|> "hash" :> Summary "Chart Hash"
          :> QueryParam "list" ListId
          :> QueryParamR "ngramsType" TabType
          :> Get '[JSON] Text
          chartApi :: NodeId -> GargServer ChartApi
          chartApi id' = getChart id'
          :<|> updateChart id'
          :<|> getChartHash id'
          chartApi :: IsGargServer err env m => NodeId -> Named.ChartAPI (AsServerT m)
          chartApi id' = Named.ChartAPI
          { getChartEp = getChart id'
          , updateChartEp = updateChart id'
          , chartHashEp = getChartHash id'
          }
          -- TODO add start / end
          getChart :: HasNodeStory env err m
          ......@@ -243,10 +216,12 @@ type PieApi = Summary "Pie Chart"
          :> QueryParamR "ngramsType" TabType
          :> Get '[JSON] Text
          pieApi :: NodeId -> GargServer PieApi
          pieApi id' = getPie id'
          :<|> updatePie id'
          :<|> getPieHash id'
          pieApi :: IsGargServer err env m => NodeId -> Named.PieAPI (AsServerT m)
          pieApi id' = Named.PieAPI
          { getPieChartEp = getPie id'
          , pieChartUpdateEp = updatePie id'
          , pieHashEp = getPieHash id'
          }
          getPie :: HasNodeStory env err m
          => CorpusId
          ......@@ -313,29 +288,12 @@ getPieHash cId maybeListId tabType = do
          -------------------------------------------------------------
          -- | Tree metrics API
          type TreeApi = Summary " Tree API"
          :> QueryParam "from" UTCTime
          :> QueryParam "to" UTCTime
          :> QueryParam "list" ListId
          :> QueryParamR "ngramsType" TabType
          :> QueryParamR "listType" ListType
          :> Get '[JSON] (HashedResponse (ChartMetrics (Vector NgramsTree)))
          :<|> Summary "Tree Chart update"
          :> QueryParam "list" ListId
          :> QueryParamR "ngramsType" TabType
          :> QueryParamR "listType" ListType
          :> Post '[JSON] ()
          :<|> "hash" :>
          Summary "Tree Hash"
          :> QueryParam "list" ListId
          :> QueryParamR "ngramsType" TabType
          :> QueryParamR "listType" ListType
          :> Get '[JSON] Text
          treeApi :: NodeId -> GargServer TreeApi
          treeApi id' = getTree id'
          :<|> updateTree id'
          :<|> getTreeHash id'
          treeApi :: IsGargServer err env m => NodeId -> Named.TreeAPI (AsServerT m)
          treeApi id' = Named.TreeAPI
          { treeChartEp = getTree id'
          , treeChartUpdateEp = updateTree id'
          , treeHashEp = getTreeHash id'
          }
          getTree :: HasNodeStory env err m
          => CorpusId
          ......
          src/Gargantext/API/Ngrams.hs
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Ngrams/List.hs
          View file @ 85353a92
          ......@@ -28,14 +28,14 @@ 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, JobLog )
          import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
          import Gargantext.API.Errors.Types (BackendInternalError)
          import Gargantext.API.Ngrams (setListNgrams)
          import Gargantext.API.Ngrams.List.Types
          import Gargantext.API.Ngrams.Prelude (getNgramsList)
          import Gargantext.API.Ngrams.Types
          import Gargantext.API.Prelude (GargServer, GargM, serverError, HasServerError)
          import Gargantext.API.Types (HTML)
          import Gargantext.API.Prelude (GargM, serverError, HasServerError)
          import Gargantext.API.Routes.Named.List qualified as Named
          import Gargantext.Core.NodeStory.Types ( HasNodeStory )
          import Gargantext.Core.Text.Ngrams (Ngrams, NgramsType(NgramsTerms))
          import Gargantext.Core.Types.Main (ListType(..))
          ......@@ -47,41 +47,25 @@ import Gargantext.Database.Schema.Node (_node_parent_id)
          import Gargantext.Database.Types (Indexed(..))
          import Gargantext.Prelude hiding (concat, toList)
          import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
          import Gargantext.Utils.Servant qualified as GUS
          import Prelude qualified
          import Protolude qualified as P
          import Servant
          import Servant.Server.Generic (AsServerT)
          ------------------------------------------------------------------------
          type GETAPI = Summary "Get List"
          :> "lists"
          :> Capture "listId" ListId
          :> ( "json"
          :> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
          :<|> "json.zip"
          :> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
          :<|> "csv"
          :> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap) )
          getApi :: GargServer GETAPI
          getApi listId = getJson listId
          :<|> getJsonZip listId
          :<|> getCsv listId
          getAPI :: Named.GETAPI (AsServerT (GargM Env BackendInternalError))
          getAPI = Named.GETAPI $ \listId -> Named.ListEndpoints
          { listJSONEp = getJson listId
          , listJSONZipEp = getJsonZip listId
          , listCSVEp = getCsv listId
          }
          --
          -- JSON API
          --
          ----------------------
          type JSONAPI = Summary "Update List"
          :> "lists"
          :> Capture "listId" ListId
          :> "add"
          :> "form"
          :> "async"
          :> AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog
          jsonApi :: ServerT JSONAPI (GargM Env BackendInternalError)
          jsonApi = jsonPostAsync
          jsonAPI :: Named.JSONAPI (AsServerT (GargM Env BackendInternalError))
          jsonAPI = jsonPostAsync
          ------------------------------------------------------------------------
          getJson :: HasNodeStory env err m
          ......@@ -122,8 +106,8 @@ getCsv lId = do
          ) _v_data
          ------------------------------------------------------------------------
          jsonPostAsync :: ServerT JSONAPI (GargM Env BackendInternalError)
          jsonPostAsync lId =
          jsonPostAsync :: Named.JSONAPI (AsServerT (GargM Env BackendInternalError))
          jsonPostAsync = Named.JSONAPI $ \lId -> AsyncJobs $
          serveJobsAPI UpdateNgramsListJobJSON $ \jHandle f ->
          postAsyncJSON lId (_wjf_data f) jHandle
          ......@@ -159,22 +143,12 @@ postAsyncJSON l ngramsList jobHandle = do
          -- CSV API
          --
          ----------------------
          type CSVAPI = Summary "Update List (legacy v3 CSV)"
          :> "lists"
          :> Capture "listId" ListId
          :> "csv"
          :> "add"
          :> "form"
          :> "async"
          :> AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog
          csvApi :: ServerT CSVAPI (GargM Env BackendInternalError)
          csvApi = csvPostAsync
          csvAPI :: Named.CSVAPI (AsServerT (GargM Env BackendInternalError))
          csvAPI = csvPostAsync
          ------------------------------------------------------------------------
          csvPostAsync :: ServerT CSVAPI (GargM Env BackendInternalError)
          csvPostAsync lId =
          csvPostAsync :: Named.CSVAPI (AsServerT (GargM Env BackendInternalError))
          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 @ 85353a92
          ......@@ -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
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Node/Contact.hs
          View file @ 85353a92
          ......@@ -21,15 +21,15 @@ module Gargantext.API.Node.Contact
          where
          import Conduit ( yield )
          import Data.Aeson
          import Data.Swagger ( ToSchema )
          import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(AuthenticatedUser) )
          import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
          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 ( nodeNodeAPI, NodeNodeAPI )
          import Gargantext.API.Node ( nodeNodeAPI )
          import Gargantext.API.Node.Contact.Types
          import Gargantext.API.Prelude (GargM, simuLogs)
          import Gargantext.API.Routes.Named.Contact qualified as Named
          import Gargantext.Core (Lang(..))
          import Gargantext.Core.Text.Terms (TermType(..))
          import Gargantext.Core.Types.Individu (User(..))
          ......@@ -38,38 +38,21 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
          import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact, hyperdataContact )
          import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire(..) )
          import Gargantext.Database.Admin.Types.Node ( CorpusId, NodeId )
          import Gargantext.Prelude (($), Generic, Maybe(..), Text)
          import Gargantext.Utils.Aeson qualified as GUA
          import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
          import Gargantext.Prelude (($), Maybe(..))
          import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
          import Servant
          import Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
          import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
          ------------------------------------------------------------------------
          type API = "contact" :> Summary "Contact endpoint"
          :> API_Async
          :<|> Capture "contact_id" NodeId
          :> NodeNodeAPI HyperdataContact
          import Servant.Server.Generic (AsServerT)
          api :: AuthenticatedUser -> CorpusId -> ServerT API (GargM Env BackendInternalError)
          api authUser@(AuthenticatedUser userNodeId _userUserId) cid =
          (api_async (RootId userNodeId) cid)
          :<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) authUser cid)
          type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
          ------------------------------------------------------------------------
          data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
          | AddContactParamsAdvanced { firstname :: !Text
          , lastname :: !Text
          -- TODO add others fields
          }
          deriving (Generic)
          contactAPI :: AuthenticatedUser -> CorpusId -> Named.ContactAPI (AsServerT (GargM Env BackendInternalError))
          contactAPI authUser@(AuthenticatedUser userNodeId _userUserId) cid = Named.ContactAPI
          { contactAsyncAPI = api_async (RootId userNodeId) cid
          , getContactEp = nodeNodeAPI (Proxy :: Proxy HyperdataContact) authUser cid
          }
          ----------------------------------------------------------------------
          api_async :: User -> NodeId -> ServerT API_Async (GargM Env BackendInternalError)
          api_async u nId =
          api_async :: User -> NodeId -> Named.ContactAsyncAPI (AsServerT (GargM Env BackendInternalError))
          api_async u nId = Named.ContactAsyncAPI $ AsyncJobs $
          serveJobsAPI AddContactJob $ \jHandle p ->
          addContact u nId p jHandle
          ......@@ -88,16 +71,3 @@ addContact u nId (AddContactParams fn ln) jobHandle = do
          addContact _uId _nId _p jobHandle = do
          simuLogs jobHandle 10
          ------------------------------------------------------------------------
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON AddContactParams where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          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/Contact/Types.hs 0 → 100644
          View file @ 85353a92
          module Gargantext.API.Node.Contact.Types where
          import Data.Aeson
          import Data.Swagger
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.Utils.Aeson qualified as GUA
          import Test.QuickCheck
          ------------------------------------------------------------------------
          data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
          | AddContactParamsAdvanced { firstname :: !Text
          , lastname :: !Text
          -- TODO add others fields
          }
          deriving (Generic)
          ------------------------------------------------------------------------
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON AddContactParams where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          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
          View file @ 85353a92
          ......@@ -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/Export.hs
          View file @ 85353a92
          ......@@ -26,7 +26,7 @@ import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo
          import Gargantext.API.Ngrams.Types ( NgramsTerm(unNgramsTerm) )
          import Gargantext.API.Node.Corpus.Export.Types ( Corpus(..) )
          import Gargantext.API.Node.Document.Export.Types qualified as DocumentExport
          import Gargantext.API.Prelude (GargNoServer)
          import Gargantext.API.Prelude (IsGargServer)
          import Gargantext.Core.NodeStory.Types ( NodeListStory )
          import Gargantext.Core.Text.Ngrams (NgramsType(..))
          import Gargantext.Core.Types.Main ( ListType(MapTerm) )
          ......@@ -42,52 +42,52 @@ import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
          import Gargantext.Database.Schema.Context (_context_id)
          import Gargantext.Prelude hiding (hash)
          import Gargantext.Prelude.Crypto.Hash (hash)
          import Servant (Headers, Header, addHeader, Summary, (:>), JSON, Get, QueryParam)
          --------------------------------------------------
          type API = Summary "Corpus Export"
          :> "export"
          :> QueryParam "listId" ListId
          :> QueryParam "ngramsType" NgramsType
          :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Corpus)
          import Servant (Headers, Header, addHeader)
          import Servant.Server.Generic (AsServerT)
          import qualified Gargantext.API.Routes.Named.Corpus as Named
          --------------------------------------------------
          -- | Hashes are ordered by Set
          getCorpus :: CorpusId
          -> Maybe ListId
          -> Maybe NgramsType
          -> GargNoServer (Headers '[Header "Content-Disposition" Text] Corpus)
          getCorpus cId lId nt' = do
          getCorpus :: forall env err m. IsGargServer env err m
          => CorpusId
          -> Named.CorpusExportAPI (AsServerT m)
          getCorpus cId = Named.CorpusExportAPI $ \lId nt' -> get_corpus lId nt'
          let
          nt = fromMaybe NgramsTerms nt'
          where
          get_corpus :: IsGargServer env err m
          => Maybe ListId
          -> Maybe NgramsType
          -> m (Headers '[Header "Content-Disposition" Text] Corpus)
          get_corpus lId nt' = do
          let
          nt = fromMaybe NgramsTerms nt'
          listId <- case lId of
          Nothing -> defaultList cId
          Just l -> pure l
          listId <- case lId of
          Nothing -> defaultList cId
          Just l -> pure l
          -- FIXME(adn) Audit the usage of this, we are converting from a node
          -- to a context id.
          ns <- Map.fromList
          <$> map (\n -> (nodeId2ContextId $ _context_id n, n))
          <$> selectDocNodes cId
          -- FIXME(adn) Audit the usage of this, we are converting from a node
          -- to a context id.
          ns <- Map.fromList
          <$> map (\n -> (nodeId2ContextId $ _context_id n, n))
          <$> selectDocNodes cId
          repo <- getRepo [listId]
          ngs <- getContextNgrams cId listId MapTerm nt repo
          let -- uniqId is hash computed already for each document imported in database
          r = Map.intersectionWith
          (\a b -> DocumentExport.Document { _d_document = context2node a
          , _d_ngrams = DocumentExport.Ngrams (Set.toList b) (hash b)
          , _d_hash = d_hash a b }
          ) ns (Map.map (Set.map unNgramsTerm) ngs)
          where
          d_hash :: Context HyperdataDocument -> Set Text -> Text
          d_hash _a b = hash [ -- fromMaybe "" (_hd_uniqId $ _context_hyperdata a),
          hash b
          ]
          pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".json")
          $ Corpus { _c_corpus = Map.elems r
          , _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
          repo <- getRepo [listId]
          ngs <- getContextNgrams cId listId MapTerm nt repo
          let -- uniqId is hash computed already for each document imported in database
          r = Map.intersectionWith
          (\a b -> DocumentExport.Document { _d_document = context2node a
          , _d_ngrams = DocumentExport.Ngrams (Set.toList b) (hash b)
          , _d_hash = d_hash a b }
          ) ns (Map.map (Set.map unNgramsTerm) ngs)
          where
          d_hash :: Context HyperdataDocument -> Set Text -> Text
          d_hash _a b = hash [ -- fromMaybe "" (_hd_uniqId $ _context_hyperdata a),
          hash b
          ]
          pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".json")
          $ Corpus { _c_corpus = Map.elems r
          , _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
          getContextNgrams :: HasNodeError err
          => CorpusId
          ......
          src/Gargantext/API/Node/Corpus/New.hs
          View file @ 85353a92
          ......@@ -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.hs
          View file @ 85353a92
          ......@@ -17,9 +17,11 @@ import Data.Csv (encodeDefaultOrderedByNameWith, defaultEncodeOptions, encDelimi
          import Data.Text qualified as T
          import Data.Text.Encoding qualified as TE
          import Data.Time.Clock.System (getSystemTime, systemSeconds)
          import Data.Time.LocalTime (getCurrentTimeZone, TimeZone (timeZoneMinutes))
          import Data.Version (showVersion)
          import Gargantext.API.Node.Document.Export.Types
          import Gargantext.API.Prelude (GargNoServer, GargServer)
          import Gargantext.API.Prelude (GargNoServer, IsGargServer)
          import Gargantext.API.Routes.Named.Document qualified as Named
          import Gargantext.Core (toDBid)
          import Gargantext.Database.Admin.Types.Node (DocId, NodeId, NodeType(..))
          import Gargantext.Database.Query.Facet (runViewDocuments, Facet(..))
          ......@@ -28,16 +30,19 @@ import Gargantext.Database.Query.Table.Node.User ( getNodeUser )
          import Gargantext.Database.Schema.Node (NodePoly(..), node_user_id)
          import Gargantext.Prelude
          import Paths_gargantext qualified as PG -- cabal magic build module
          import Servant ( addHeader, (:<|>)((:<|>)), Header, Headers(getResponse) )
          import Data.Time.LocalTime (getCurrentTimeZone, TimeZone (timeZoneMinutes))
          import Servant ( addHeader, Header, Headers(getResponse) )
          import Servant.Server.Generic (AsServerT)
          api :: NodeId
          -- ^ The ID of the target user
          -> DocId
          -> GargServer API
          api userNodeId dId = getDocumentsJSON userNodeId dId
          :<|> getDocumentsJSONZip userNodeId dId
          :<|> getDocumentsCSV userNodeId dId
          documentExportAPI :: IsGargServer env err m
          => NodeId
          -- ^ The ID of the target user
          -> DocId
          -> Named.DocumentExportAPI (AsServerT m)
          documentExportAPI userNodeId dId = Named.DocumentExportAPI $ Named.DocumentExportEndpoints
          { exportJSONEp = getDocumentsJSON userNodeId dId
          , exportJSONZipEp = getDocumentsJSONZip userNodeId dId
          , exportCSVEp = getDocumentsCSV userNodeId dId
          }
          --------------------------------------------------
          -- | Hashes are ordered by Set
          ......
          src/Gargantext/API/Node/Document/Export/Types.hs
          View file @ 85353a92
          ......@@ -27,7 +27,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..))
          import Gargantext.Utils.Servant (ZIP)
          import Gargantext.Utils.Zip (zipContentsPureWithLastModified)
          import Protolude
          import Servant ((:>), (:<|>), Get, Header, Headers(..), JSON, MimeRender(..), PlainText, Summary)
          import Servant (MimeRender(..), MimeUnrender(..))
          -- | Document Export
          ......@@ -101,15 +101,6 @@ instance ToParamSchema Document where
          instance ToParamSchema Ngrams where
          toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
          --------------------------------------------------
          type API = Summary "Document Export"
          :> "export"
          :> ( "json"
          :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
          :<|> "json.zip"
          :> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
          :<|> "csv"
          :> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text) )
          $(deriveJSON (unPrefix "_ng_") ''Ngrams)
          $(deriveJSON (unPrefix "_d_") ''Document)
          ......@@ -127,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 @ 85353a92
          ......@@ -17,18 +17,17 @@ Portability : POSIX
          module Gargantext.API.Node.DocumentUpload where
          import Control.Lens (view)
          import Data.Aeson ( Options(..), genericParseJSON, defaultOptions, genericToJSON, SumEncoding(..) )
          import Data.Swagger (ToSchema)
          import Data.Text qualified as T
          import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
          import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
          import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.API.Errors.Types ( BackendInternalError )
          import Gargantext.API.Node.DocumentUpload.Types
          import Gargantext.API.Prelude ( GargM )
          import Gargantext.API.Routes.Named.Document qualified as Named
          import Gargantext.Core (Lang(..))
          import Gargantext.Core.NLP (nlpServerGet)
          import Gargantext.Core.Text.Corpus.Parsers.Date (mDateSplit)
          import Gargantext.Core.Text.Terms (TermType(..))
          import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
          import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus)
          import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
          import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataCorpus )
          ......@@ -37,47 +36,11 @@ import Gargantext.Database.Admin.Types.Node ( DocId, NodeId, NodeType(NodeCorpus
          import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
          import Gargantext.Prelude
          import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
          import Servant ( JSON, Summary, type (:>), HasServer(ServerT) )
          import Servant.Server.Generic (AsServerT)
          data DocumentUpload = DocumentUpload
          { _du_abstract :: T.Text
          , _du_authors :: T.Text
          , _du_sources :: T.Text
          , _du_title :: T.Text
          , _du_date :: T.Text
          , _du_language :: T.Text
          }
          deriving (Generic)
          $(makeLenses ''DocumentUpload)
          instance ToSchema DocumentUpload
          instance FromJSON DocumentUpload
          where
          parseJSON = genericParseJSON
          ( defaultOptions { sumEncoding = ObjectWithSingleField
          , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
          , omitNothingFields = True
          }
          )
          instance ToJSON DocumentUpload
          where
          toJSON = genericToJSON
          ( defaultOptions { sumEncoding = ObjectWithSingleField
          , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
          , omitNothingFields = True
          }
          )
          type API = Summary " Document upload"
          :> "document"
          :> "upload"
          :> "async"
          :> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
          api :: NodeId -> ServerT API (GargM Env BackendInternalError)
          api nId =
          api :: NodeId -> Named.DocumentUploadAPI (AsServerT (GargM Env BackendInternalError))
          api nId = Named.DocumentUploadAPI $ AsyncJobs $
          serveJobsAPI UploadDocumentJob $ \jHandle q -> do
          documentUploadAsync nId q jHandle
          ......
          src/Gargantext/API/Node/DocumentUpload/Types.hs 0 → 100644
          View file @ 85353a92
          {-# LANGUAGE TemplateHaskell #-}
          module Gargantext.API.Node.DocumentUpload.Types where
          import Data.Aeson ( Options(..), genericParseJSON, defaultOptions, genericToJSON, SumEncoding(..) )
          import Data.Swagger (ToSchema)
          import Data.Text qualified as T
          import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
          import Gargantext.Prelude
          data DocumentUpload = DocumentUpload
          { _du_abstract :: T.Text
          , _du_authors :: T.Text
          , _du_sources :: T.Text
          , _du_title :: T.Text
          , _du_date :: T.Text
          , _du_language :: T.Text
          }
          deriving (Generic)
          $(makeLenses ''DocumentUpload)
          instance ToSchema DocumentUpload
          instance FromJSON DocumentUpload
          where
          parseJSON = genericParseJSON
          ( defaultOptions { sumEncoding = ObjectWithSingleField
          , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
          , omitNothingFields = True
          }
          )
          instance ToJSON DocumentUpload
          where
          toJSON = genericToJSON
          ( defaultOptions { sumEncoding = ObjectWithSingleField
          , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
          , omitNothingFields = True
          }
          )
          src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
          View file @ 85353a92
          ......@@ -17,22 +17,21 @@ module Gargantext.API.Node.DocumentsFromWriteNodes
          where
          import Conduit ( yieldMany )
          import Data.Aeson ( genericParseJSON, defaultOptions, genericToJSON )
          import Data.List qualified as List
          import Data.Swagger ( ToSchema )
          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 (JobLog(..), AsyncJobs)
          import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.API.Admin.Types (HasSettings)
          import Gargantext.API.Errors.Types ( BackendInternalError )
          import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
          import Gargantext.API.Node.DocumentsFromWriteNodes.Types
          import Gargantext.API.Prelude (GargM)
          import Gargantext.API.Routes.Named.Document qualified as Named
          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.List.Social (FlowSocialListWith)
          import Gargantext.Core.Text.Terms (TermType(..))
          import Gargantext.Core.Types.Individu (User(..))
          import Gargantext.Database.Action.Flow (flowDataText, DataText(..))
          ......@@ -46,30 +45,13 @@ import Gargantext.Prelude
          import Gargantext.System.Logging
          import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
          import Gargantext.Utils.Jobs.Error
          import Servant ( JSON, Summary, type (:>), HasServer(ServerT) )
          import Servant.Server.Generic (AsServerT)
          ------------------------------------------------------------------------
          type API = Summary " Documents from Write nodes."
          :> AsyncJobs JobLog '[JSON] Params JobLog
          ------------------------------------------------------------------------
          data Params = Params
          { id :: Int
          , paragraphs :: Text
          , lang :: Lang
          , selection :: FlowSocialListWith
          }
          deriving (Generic, Show)
          instance FromJSON Params where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON Params where
          toJSON = genericToJSON defaultOptions
          instance ToSchema Params
          ------------------------------------------------------------------------
          api :: AuthenticatedUser
          -- ^ The logged-in user
          -> NodeId
          -> ServerT API (GargM Env BackendInternalError)
          api authenticatedUser nId =
          -> Named.DocumentsFromWriteNodesAPI (AsServerT (GargM Env BackendInternalError))
          api authenticatedUser nId = Named.DocumentsFromWriteNodesAPI $ AsyncJobs $
          serveJobsAPI DocumentFromWriteNodeJob $ \jHandle p ->
          documentsFromWriteNodes authenticatedUser nId p jHandle
          ......
          src/Gargantext/API/Node/DocumentsFromWriteNodes/Types.hs 0 → 100644
          View file @ 85353a92
          module Gargantext.API.Node.DocumentsFromWriteNodes.Types where
          import Data.Aeson ( genericParseJSON, defaultOptions, genericToJSON )
          import Data.Swagger ( ToSchema )
          import Gargantext.Core (Lang(..))
          import Gargantext.Core.Text.List.Social (FlowSocialListWith)
          import Gargantext.Prelude
          ------------------------------------------------------------------------
          data Params = Params
          { id :: Int
          , paragraphs :: Text
          , lang :: Lang
          , selection :: FlowSocialListWith
          }
          deriving (Generic, Show)
          instance FromJSON Params where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON Params where
          toJSON = genericToJSON defaultOptions
          instance ToSchema Params
          ------------------------------------------------------------------------
          src/Gargantext/API/Node/File.hs
          View file @ 85353a92
          ......@@ -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 0 → 100644
          View file @ 85353a92
          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 @ 85353a92
          ......@@ -17,19 +17,18 @@ module Gargantext.API.Node.FrameCalcUpload where
          import Data.ByteString.Lazy qualified as BSL
          import Data.ByteString.UTF8 qualified as BSU8
          import Data.Swagger ( ToSchema )
          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 (JobLog(..), AsyncJobs)
          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(..))
          import Gargantext.API.Node.FrameCalcUpload.Types
          import Gargantext.API.Node.Types (NewWithForm(..))
          import Gargantext.API.Prelude ( GargM )
          import Gargantext.Core (Lang)
          import Gargantext.API.Routes.Named.FrameCalc qualified as Named
          import Gargantext.Core.NodeStory.Types ( HasNodeArchiveStoryImmediateSaver )
          import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
          import Gargantext.Core.Types.Individu (User(..))
          import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
          import Gargantext.Database.Admin.Types.Hyperdata.Frame ( HyperdataFrame(..) )
          ......@@ -41,29 +40,11 @@ import Gargantext.Prelude
          import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..), markFailureNoErr)
          import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
          import Network.HTTP.Client.TLS (tlsManagerSettings)
          import Servant ( type (:>), JSON, Summary, HasServer(ServerT) )
          import Web.FormUrlEncoded (FromForm)
          import Servant.Server.Generic (AsServerT)
          data FrameCalcUpload = FrameCalcUpload {
          _wf_lang :: !(Maybe Lang)
          , _wf_selection :: !FlowSocialListWith
          }
          deriving (Generic)
          instance FromForm FrameCalcUpload
          instance FromJSON FrameCalcUpload
          instance ToJSON FrameCalcUpload
          instance ToSchema FrameCalcUpload
          type API = Summary " FrameCalc upload"
          :> "add"
          :> "framecalc"
          :> "async"
          :> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
          api :: AuthenticatedUser -> NodeId -> ServerT API (GargM Env BackendInternalError)
          api authenticatedUser nId =
          api :: AuthenticatedUser -> NodeId -> Named.FrameCalcAPI (AsServerT (GargM Env BackendInternalError))
          api authenticatedUser nId = Named.FrameCalcAPI $ AsyncJobs $
          serveJobsAPI UploadFrameCalcJob $ \jHandle p ->
          frameCalcUploadAsync authenticatedUser nId p jHandle
          ......
          src/Gargantext/API/Node/FrameCalcUpload/Types.hs 0 → 100644
          View file @ 85353a92
          module Gargantext.API.Node.FrameCalcUpload.Types where
          import Data.Swagger ( ToSchema )
          import Gargantext.Core (Lang)
          import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
          import Gargantext.Prelude
          import Web.FormUrlEncoded (FromForm)
          data FrameCalcUpload = FrameCalcUpload {
          _wf_lang :: !(Maybe Lang)
          , _wf_selection :: !FlowSocialListWith
          }
          deriving (Generic)
          instance FromForm FrameCalcUpload
          instance FromJSON FrameCalcUpload
          instance ToJSON FrameCalcUpload
          instance ToSchema FrameCalcUpload
          src/Gargantext/API/Node/Get.hs
          View file @ 85353a92
          ......@@ -22,32 +22,16 @@ module Gargantext.API.Node.Get
          import Data.Aeson
          import Data.Swagger
          import Gargantext.API.Prelude
          import Gargantext.Database.Admin.Types.Node
          import Gargantext.Database.Prelude (JSONB)
          import Gargantext.Prelude
          import Servant
          import Test.QuickCheck.Arbitrary
          ------------------------------------------------------------------------
          type API a = Summary "Polymorphic Get Node Endpoint"
          :> ReqBody '[JSON] GetNodeParams
          :> Get '[JSON] (Node a)
          ------------------------------------------------------------------------
          data GetNodeParams = GetNodeParams { node_id :: NodeId
          , nodetype :: NodeType
          }
          deriving (Generic)
          ----------------------------------------------------------------------
          api :: forall proxy a.
          ( JSONB a
          , FromJSON a
          , ToJSON a
          ) => proxy a -> UserId -> NodeId -> GargServer (API a)
          api _p _uId _nId (GetNodeParams _nId' _nt) = undefined
          ------------------------------------------------------------------------
          instance FromJSON GetNodeParams where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
          ......
          src/Gargantext/API/Node/New.hs
          View file @ 85353a92
          ......@@ -21,13 +21,13 @@ module Gargantext.API.Node.New
          where
          import Control.Lens hiding (elements, Empty)
          import Data.Aeson
          import Data.Swagger
          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
          import Gargantext.API.Routes.Named.Node qualified as Named
          import Gargantext.Core.AsyncUpdates.CentralExchange qualified as CE
          import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CE
          import Gargantext.Database.Action.Flow.Types
          ......@@ -37,24 +37,7 @@ 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 Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary
          import Web.FormUrlEncoded (FromForm, ToForm)
          ------------------------------------------------------------------------
          data PostNode = PostNode { pn_name :: Text
          , pn_typename :: NodeType}
          deriving (Generic)
          ------------------------------------------------------------------------
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON PostNode
          instance ToJSON PostNode
          instance ToSchema PostNode
          instance FromForm PostNode
          instance ToForm PostNode
          instance Arbitrary PostNode where
          arbitrary = elements [PostNode "Node test" NodeCorpus]
          import Servant.Server.Generic (AsServerT)
          ------------------------------------------------------------------------
          postNode :: HasNodeError err
          ......@@ -73,19 +56,13 @@ postNode authenticatedUser pId (PostNode nodeName nt) = do
          return nodeIds
          ------------------------------------------------------------------------
          type PostNodeAsync = Summary "Post Node"
          :> "async"
          :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
          postNodeAsyncAPI
          :: AuthenticatedUser
          -- ^ The logged-in user
          -> NodeId
          -- ^ The target node
          -> ServerT PostNodeAsync (GargM Env BackendInternalError)
          postNodeAsyncAPI authenticatedUser nId =
          -> Named.PostNodeAsyncAPI (AsServerT (GargM Env BackendInternalError))
          postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
          serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync authenticatedUser nId p jHandle
          ------------------------------------------------------------------------
          ......
          src/Gargantext/API/Node/New/Types.hs 0 → 100644
          View file @ 85353a92
          module Gargantext.API.Node.New.Types (
          PostNode(..)
          ) where
          import Data.Aeson
          import Data.Swagger
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.Core.Types (NodeType (..))
          import Test.QuickCheck
          import Web.FormUrlEncoded
          ------------------------------------------------------------------------
          data PostNode = PostNode { pn_name :: Text
          , pn_typename :: NodeType}
          deriving (Generic)
          ------------------------------------------------------------------------
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON PostNode
          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
          View file @ 85353a92
          ......@@ -13,20 +13,24 @@ module Gargantext.API.Node.Phylo.Export
          import Data.Aeson
          import Data.Text qualified as T
          import Gargantext.API.Node.Phylo.Export.Types
          import Gargantext.API.Prelude (GargNoServer, GargServer)
          import Gargantext.API.Prelude (GargNoServer, IsGargServer)
          import Gargantext.API.Routes.Named.Viz qualified as Named
          import Gargantext.Core.Viz.Phylo.API.Tools
          import Gargantext.Core.Viz.Phylo.Example (phyloCleopatre)
          import Gargantext.Database.Admin.Types.Node (PhyloId, NodeId,)
          import Gargantext.Prelude
          import Servant
          import Servant.Server.Generic (AsServerT)
          api :: NodeId
          api :: IsGargServer env err m
          => NodeId
          -- ^ The ID of the target user
          -> PhyloId
          -> GargServer API
          api userNodeId dId = getPhyloJson userNodeId dId
          :<|> getPhyloDot userNodeId dId
          -> Named.PhyloExportAPI (AsServerT m)
          api userNodeId dId = Named.PhyloExportAPI $ Named.PhyloExportEndpoints
          { exportPhyloJSONEp = getPhyloJson userNodeId dId
          , exportPhyloDotEp = getPhyloDot userNodeId dId
          }
          getPhyloJson :: NodeId
          -- ^ The ID of the target user
          ......@@ -54,4 +58,4 @@ getPhyloDot _ pId = do
          , "GarganText_Phylo-"
          , T.pack (show pId)
          , ".dot" ])
          phyloDot
          \ No newline at end of file
          phyloDot
          src/Gargantext/API/Node/Phylo/Export/Types.hs
          View file @ 85353a92
          ......@@ -13,7 +13,6 @@ Portability : POSIX
          module Gargantext.API.Node.Phylo.Export.Types where
          import Data.Aeson
          import Data.Aeson.TH (deriveJSON)
          -- import Data.Csv (DefaultOrdered(..), ToNamedRecord(..), (.=), header, namedRecord)
          import Data.Swagger ( genericDeclareNamedSchema, ToParamSchema(..), ToSchema(..) )
          ......@@ -27,7 +26,7 @@ import Gargantext.Database.Admin.Types.Node (PhyloId)
          -- import Gargantext.Utils.Servant (ZIP)
          -- import Gargantext.Utils.Zip (zipContentsPure)
          import Protolude
          import Servant ((:>), (:<|>), Get, Header, Headers(..), JSON, Summary) --, PlainText, MimeRender(..)
          --, PlainText, MimeRender(..)
          -- | Phylo Export
          ......@@ -97,14 +96,6 @@ instance ToParamSchema Phylo where
          toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
          --------------------------------------------------
          type API = Summary "Phylo Export"
          :> "export"
          :> ( "json"
          :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Value)
          :<|> "dot"
          :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Text)
          )
          -- type API = Summary "Phylo Export"
          -- :> "export"
          -- :> Get '[JSON,DOT] (Headers '[Servant.Header "Content-Disposition" Text] Value)
          ......
          src/Gargantext/API/Node/Share.hs
          View file @ 85353a92
          ......@@ -15,11 +15,11 @@ Portability : POSIX
          module Gargantext.API.Node.Share
          where
          import Data.Aeson
          import Data.List qualified as List
          import Data.Swagger
          import Data.Text qualified as Text
          import Gargantext.API.Node.Share.Types
          import Gargantext.API.Prelude
          import Gargantext.API.Routes.Named.Share qualified as Named
          import Gargantext.Core.NLP (HasNLPServer)
          import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
          import Gargantext.Database.Action.Share (ShareNodeWith(..))
          ......@@ -31,26 +31,8 @@ import Gargantext.Database.Prelude (CmdRandom)
          import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
          import Gargantext.Database.Query.Tree (findNodesWithType)
          import Gargantext.Prelude
          import Gargantext.Utils.Aeson qualified as GUA
          import Servant
          import Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary
          import Servant.Server.Generic (AsServerT)
          ------------------------------------------------------------------------
          data ShareNodeParams = ShareTeamParams { username :: Text }
          | SharePublicParams { node_id :: NodeId }
          deriving (Generic)
          ------------------------------------------------------------------------
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON ShareNodeParams where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          instance ToJSON ShareNodeParams where
          toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          instance ToSchema ShareNodeParams
          instance Arbitrary ShareNodeParams where
          arbitrary = elements [ ShareTeamParams "user1"
          , SharePublicParams (UnsafeMkNodeId 1)
          ]
          ------------------------------------------------------------------------
          -- TODO permission
          -- TODO refactor userId which is used twice
          ......@@ -98,15 +80,5 @@ api _uId nId2 (SharePublicParams nId1) =
          fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2
          ------------------------------------------------------------------------
          type API = Summary " Share Node with username"
          :> ReqBody '[JSON] ShareNodeParams
          :> Post '[JSON] Int
          ------------------------------------------------------------------------
          type Unpublish = Summary " Unpublish Node"
          :> Capture "node_id" NodeId
          :> Put '[JSON] Int
          unPublish :: NodeId -> GargServer Unpublish
          unPublish n = DB.unPublish n
          unPublish :: IsGargServer env err m => NodeId -> Named.Unpublish (AsServerT m)
          unPublish n = Named.Unpublish $ DB.unPublish n
          src/Gargantext/API/Node/Share/Types.hs 0 → 100644
          View file @ 85353a92
          module Gargantext.API.Node.Share.Types where
          import Data.Aeson
          import Data.Swagger
          import Gargantext.Database.Admin.Types.Node
          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 }
          deriving (Generic)
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON ShareNodeParams where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          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
          View file @ 85353a92
          ......@@ -6,24 +6,20 @@ module Gargantext.API.Node.ShareURL where
          import Data.Text
          import Gargantext.Prelude
          import Gargantext.API.Prelude
          import Servant
          import Gargantext.Core.Types (NodeType, NodeId, unNodeId)
          import Gargantext.Database.Prelude (HasConfig (hasConfig), CmdCommon)
          import Control.Lens.Getter (view)
          import Gargantext.Prelude.Config (gc_url)
          import Gargantext.API.Admin.EnvTypes (Env)
          import Gargantext.API.Errors (BackendInternalError)
          import Gargantext.API.Routes.Named.Share qualified as Named
          import Servant.Server.Generic (AsServerT)
          type API = Summary "Fetch URL for sharing a node"
          :> QueryParam "type" NodeType
          :> QueryParam "id" NodeId
          :> Get '[JSON] Text
          shareURL :: IsGargServer env err m => Named.ShareURL (AsServerT m)
          shareURL = Named.ShareURL getUrl
          api :: ServerT API (GargM Env BackendInternalError)
          api = getUrl
          getUrl :: (CmdCommon env) =>
          Maybe NodeType -> Maybe NodeId -> GargM env BackendInternalError Text
          getUrl :: (IsGargServer env err m, CmdCommon env)
          => Maybe NodeType
          -> Maybe NodeId
          -> m Text
          getUrl nt id = do
          -- TODO add check that the node is able to be shared (in a shared folder)
          case nt of
          ......
          src/Gargantext/API/Node/Types.hs
          View file @ 85353a92
          ......@@ -23,6 +23,8 @@ import Gargantext.API.Node.Corpus.Types
          import Gargantext.Core (Lang(..))
          import Gargantext.Core.Text.Corpus.Query qualified as API
          import Gargantext.Core.Text.List.Social (FlowSocialListWith)
          import Gargantext.Core.Types (NodeId)
          import Gargantext.Core.Utils.Prefix (unPrefix)
          import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
          import Gargantext.Database.GargDB qualified as GargDB
          import Gargantext.Prelude
          ......@@ -113,3 +115,32 @@ instance Arbitrary WithQuery where
          <*> arbitrary
          <*> arbitrary
          ------------------------------------------------------------------------
          data RenameNode = RenameNode { r_name :: Text }
          deriving (Generic)
          $(deriveJSON (unPrefix "r_" ) ''RenameNode )
          instance ToSchema RenameNode
          instance Arbitrary RenameNode where
          arbitrary = elements [RenameNode "test"]
          data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
          , nts_score :: Int
          }
          deriving (Generic)
          -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON NodesToScore
          instance ToJSON NodesToScore
          instance ToSchema NodesToScore
          data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
          , ntc_category :: Int
          }
          deriving (Generic)
          -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON NodesToCategory
          instance ToJSON NodesToCategory
          instance ToSchema NodesToCategory
          src/Gargantext/API/Node/Update.hs
          View file @ 85353a92
          ......@@ -16,24 +16,21 @@ module Gargantext.API.Node.Update
          where
          import Control.Lens (view)
          import Data.Aeson
          import Data.Set qualified as Set
          import Data.Swagger ( ToSchema )
          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.Metrics qualified as Metrics
          import Gargantext.API.Ngrams.Types qualified as NgramsTypes
          import Gargantext.API.Node.Update.Types
          import Gargantext.API.Prelude (GargM, simuLogs)
          import Gargantext.Core.Methods.Similarities (GraphMetric(..))
          import Gargantext.API.Routes.Named.Node qualified as Named
          import Gargantext.Core.NodeStory.Types (HasNodeStory)
          import Gargantext.Core.Text.Ngrams (NgramsType(NgramsTerms))
          import Gargantext.Core.Types.Main (ListType(..))
          import Gargantext.Core.Viz.Graph.API (recomputeGraph)
          import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
          import Gargantext.Core.Viz.Graph.Types (Strength)
          import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..), subConfigAPI2config)
          import Gargantext.Core.Viz.Phylo (subConfigAPI2config)
          import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
          import Gargantext.Database.Action.Flow (reIndexWith)
          import Gargantext.Database.Action.Flow.Pairing (pairing)
          ......@@ -45,53 +42,13 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
          import Gargantext.Database.Schema.Node (node_parent_id)
          import Gargantext.Prelude
          import Gargantext.System.Logging ( MonadLogger )
          import Gargantext.Utils.Aeson qualified as GUA
          import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
          import Gargantext.Utils.UTCTime (timeMeasured)
          import Servant
          import Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
          import Servant.Server.Generic (AsServerT)
          ------------------------------------------------------------------------
          type API = Summary " Update node according to NodeType params"
          :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
          ------------------------------------------------------------------------
          data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
          | UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
          , methodGraphClustering :: !PartitionMethod
          , methodGraphBridgeness :: !BridgenessMethod
          , methodGraphEdgesStrength :: !Strength
          , methodGraphNodeType1 :: !NgramsType
          , methodGraphNodeType2 :: !NgramsType
          }
          | UpdateNodeParamsTexts { methodTexts :: !Granularity }
          | UpdateNodeParamsBoard { methodBoard :: !Charts }
          | LinkNodeReq { nodeType :: !NodeType
          , id :: !NodeId }
          | UpdateNodePhylo { config :: !PhyloSubConfigAPI }
          deriving (Generic)
          ----------------------------------------------------------------------
          data Method = Basic | Advanced | WithModel
          deriving (Generic, Eq, Ord, Enum, Bounded)
          ----------------------------------------------------------------------
          data Granularity = NewNgrams | NewTexts | Both
          deriving (Generic, Eq, Ord, Enum, Bounded)
          ----------------------------------------------------------------------
          data Charts = Sources | Authors | Institutes | Ngrams | All
          deriving (Generic, Eq, Ord, Enum, Bounded)
          ------------------------------------------------------------------------
          api :: NodeId -> ServerT API (GargM Env BackendInternalError)
          api nId =
          api :: NodeId -> Named.UpdateAPI (AsServerT (GargM Env BackendInternalError))
          api nId = Named.UpdateAPI $ AsyncJobs $
          serveJobsAPI UpdateNodeJob $ \jHandle p ->
          updateNode nId p jHandle
          ......@@ -206,39 +163,3 @@ updateDocs cId = do
          -- printDebug "updateContextsScore" (cId, lId, u)
          pure ()
          ------------------------------------------------------------------------
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON UpdateNodeParams where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          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 <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> 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 ]
          ------------------------------------------------------------------------
          src/Gargantext/API/Node/Update/Types.hs 0 → 100644
          View file @ 85353a92
          module Gargantext.API.Node.Update.Types where
          import Data.Aeson
          import Data.Swagger ( ToSchema )
          import Gargantext.Core.Methods.Similarities (GraphMetric(..))
          import Gargantext.Core.Text.Ngrams (NgramsType)
          import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
          import Gargantext.Core.Viz.Graph.Types (Strength)
          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 }
          | UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
          , methodGraphClustering :: !PartitionMethod
          , methodGraphBridgeness :: !BridgenessMethod
          , methodGraphEdgesStrength :: !Strength
          , methodGraphNodeType1 :: !NgramsType
          , methodGraphNodeType2 :: !NgramsType
          }
          | UpdateNodeParamsTexts { methodTexts :: !Granularity }
          | UpdateNodeParamsBoard { methodBoard :: !Charts }
          | LinkNodeReq { nodeType :: !NodeType
          , id :: !NodeId }
          | UpdateNodePhylo { config :: !PhyloSubConfigAPI }
          deriving (Generic)
          ----------------------------------------------------------------------
          data Method = Basic | Advanced | WithModel
          deriving (Generic, Eq, Ord, Enum, Bounded)
          ----------------------------------------------------------------------
          data Granularity = NewNgrams | NewTexts | Both
          deriving (Generic, Eq, Ord, Enum, Bounded)
          ----------------------------------------------------------------------
          data Charts = Sources | Authors | Institutes | Ngrams | All
          deriving (Generic, Eq, Ord, Enum, Bounded)
          ------------------------------------------------------------------------
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON UpdateNodeParams where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          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 <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> 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 ]
          ------------------------------------------------------------------------
          src/Gargantext/API/Prelude.hs
          View file @ 85353a92
          ......@@ -77,6 +77,9 @@ type GargServerT env err m api = GargServerC env err m => ServerT api m
          type GargServer api = forall env err m. MonadLogger m => GargServerT env err m api
          class (MonadLogger m, GargServerC env err m) => IsGargServer env err m
          -- = forall env err m. (MonadLogger m, GargServerC env err m) => AsServerT m
          -- This is the concrete monad. It needs to be used as little as possible.
          type GargM env err = ReaderT env (ExceptT err IO)
          -- This is the server type using GargM. It needs to be used as little as possible.
          ......
          src/Gargantext/API/Public/Types.hs 0 → 100644
          View file @ 85353a92
          module Gargantext.API.Public.Types (
          PublicData(..)
          , defaultPublicData
          ) where
          import Data.Aeson
          import Data.Swagger
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.Utils.Aeson qualified as GUA
          import Prelude
          import Test.QuickCheck
          data PublicData = PublicData
          { title :: Text
          , abstract :: Text
          , img :: Text
          , url :: Text
          , date :: Text
          , database :: Text
          , author :: Text
          } | NoData { nodata:: Text}
          deriving (Generic)
          instance FromJSON PublicData where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          instance ToJSON PublicData where
          toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          instance ToSchema PublicData
          instance Arbitrary PublicData where
          arbitrary = elements
          $ replicate 6 defaultPublicData
          defaultPublicData :: PublicData
          defaultPublicData =
          PublicData { title = "Title"
          , abstract = foldl (<>) "" $ replicate 100 "abstract "
          , img = "images/Gargantextuel-212x300.jpg"
          , url = "https://.."
          , date = "YY/MM/DD"
          , database = "database"
          , author = "Author" }
          src/Gargantext/API/Routes.hs
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Routes/Named.hs
          View file @ 85353a92
          {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE DeriveGeneric #-}
          module Gargantext.API.Routes.Named where
          {-# LANGUAGE TypeApplications #-}
          module Gargantext.API.Routes.Named (
          -- * Routes types
          API(..)
          , NamedAPI(..)
          , SwaggerAPI(..)
          , BackEndAPI(..)
          , MkBackEndAPI(..)
          , GargAPIVersion(..)
          , GargAPI'(..)
          , AuthAPI(..)
          , ForgotPasswordAPI(..)
          , ForgotPasswordAsyncAPI(..)
          , GargVersion(..)
          ) where
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.API.Admin.Auth (ForgotPasswordAsyncParams)
          import Gargantext.API.Admin.Auth.Types
          import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
          import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.API.Routes.Named.Public
          import Gargantext.API.GraphQL qualified as GraphQL
          import Gargantext.API.Routes.Named.Private
          import Gargantext.API.Routes.Named.Public
          import Gargantext.API.Routes.Types
          import Gargantext.Core.AsyncUpdates.Dispatcher qualified as Dispatcher
          import Servant.API ((:>), (:-), JSON, ReqBody, Post, Get, QueryParam)
          import Servant.API.Description (Summary)
          import Servant.API.NamedRoutes
          import Servant.Auth.Swagger ()
          import Servant.Swagger.UI
          type GargAPI = NamedRoutes (MkGargAPI (GargAPIVersion GargAPI'))
          newtype API mode = API
          { apiWithCustomErrorScheme :: mode :- WithCustomErrorScheme (NamedRoutes NamedAPI)
          } deriving Generic
          data NamedAPI mode = NamedAPI
          { swaggerAPI :: mode :- SwaggerSchemaUI "swagger-ui" "swagger.json"
          , backendAPI :: mode :- NamedRoutes BackEndAPI
          , graphqlAPI :: mode :- GraphQL.API -- FIXME(adn) convert to named!
          , frontendAPI :: mode :- FrontEndAPI
          , wsAPI :: mode :- NamedRoutes Dispatcher.WSAPI
          } deriving Generic
          newtype SwaggerAPI mode = SwaggerAPI
          { swaggerSchemaEp :: mode :- SwaggerSchemaUI "swagger-ui" "swagger.json"
          } deriving Generic
          newtype BackEndAPI mode = BackEndAPI {
          backendAPI' :: mode :- NamedRoutes (MkBackEndAPI (GargAPIVersion GargAPI'))
          } deriving Generic
          data MkGargAPI sub mode = MkGargAPI
          { mkGargAPI :: mode :- "api" :> Summary "API " :> NamedRoutes sub
          newtype MkBackEndAPI sub mode = MkBackEndAPI
          { mkBackEndAPI :: mode :- "api" :> Summary "Backend API " :> NamedRoutes sub
          } deriving Generic
          data GargAPIVersion sub mode = GargAPIVersion
          newtype GargAPIVersion sub mode = GargAPIVersion
          { gargAPIVersion :: mode :- "v1.0" :> Summary "Garg API Version " :> NamedRoutes sub
          } deriving Generic
          ......@@ -38,7 +79,7 @@ data GargAPI' mode = GargAPI'
          } deriving Generic
          data AuthAPI mode = AuthAPI
          newtype AuthAPI mode = AuthAPI
          { authEp :: mode :- "auth" :> Summary "AUTH API"
          :> ReqBody '[JSON] AuthRequest
          :> Post '[JSON] AuthResponse
          ......@@ -57,10 +98,10 @@ 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
          data GargVersion mode = GargVersion
          { gargVersionEp :: "version" :> Summary "Backend version" :> Get '[JSON] Text
          { gargVersionEp :: mode :- "version" :> Summary "Backend version" :> Get '[JSON] Text
          } deriving Generic
          src/Gargantext/API/Routes/Named/Annuaire.hs 0 → 100644
          View file @ 85353a92
          {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE DeriveGeneric #-}
          module Gargantext.API.Routes.Named.Annuaire (
          -- * Routes types
          AddAnnuaireWithForm(..)
          ) where
          import GHC.Generics
          import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
          import Gargantext.Database.Admin.Types.Node
          import Servant
          newtype AddAnnuaireWithForm mode = AddAnnuaireWithForm
          { addWithFormEp :: mode :- Summary "Add with FormUrlEncoded to annuaire endpoint"
          :> "annuaire"
          :> Capture "annuaire_id" AnnuaireId
          :> "add"
          :> "form"
          :> "async"
          :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog)
          } deriving Generic
          src/Gargantext/API/Routes/Named/Contact.hs
          View file @ 85353a92
          ......@@ -10,9 +10,9 @@ module Gargantext.API.Routes.Named.Contact (
          ) where
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.API.Node.Contact.Types (AddContactParams(..))
          import Gargantext.API.Routes.Named.Node (NodeNodeAPI(..))
          import Gargantext.Database.Admin.Types.Hyperdata.Contact
          import Gargantext.Database.Admin.Types.Node
          ......@@ -26,13 +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
          data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
          | AddContactParamsAdvanced { firstname :: !Text
          , lastname :: !Text
          -- TODO add others fields
          }
          deriving Generic
          src/Gargantext/API/Routes/Named/Context.hs
          View file @ 85353a92
          {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE DeriveGeneric #-}
          module Gargantext.API.Routes.Named.Context where
          module Gargantext.API.Routes.Named.Context (
          -- * Routes types
          ContextAPI(..)
          ) where
          import GHC.Generics
          import Gargantext.Database.Admin.Types.Node
          import Servant
          data ContextAPI mode a = ContextAPI
          data ContextAPI a mode = ContextAPI
          { getNodeEp :: mode :- Get '[JSON] (Node a)
          } deriving Generic
          src/Gargantext/API/Routes/Named/Corpus.hs
          View file @ 85353a92
          ......@@ -10,7 +10,6 @@ module Gargantext.API.Routes.Named.Corpus (
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.API.Node.Corpus.Annuaire hiding (AddWithForm)
          import Gargantext.API.Node.Corpus.Export.Types
          import Gargantext.API.Node.Types
          import Gargantext.Core.Text.Ngrams (NgramsType(..))
          ......@@ -27,20 +26,19 @@ newtype CorpusExportAPI mode = CorpusExportAPI
          } deriving Generic
          newtype AddWithForm mode = AddWithForm
          { addWithFormEp :: mode :- Summary "Add with FormUrlEncoded to annuaire endpoint"
          :> "annuaire"
          :> Capture "annuaire_id" AnnuaireId
          { addWithFormEp :: mode :- Summary "Add with FormUrlEncoded to corpus endpoint"
          :> "corpus"
          :> Capture "corpus_id" CorpusId
          :> "add"
          :> "form"
          :> "async"
          :> AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog
          :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog)
          } deriving Generic
          newtype AddWithQuery mode = AddWithQuery
          { addWithQueryEp :: mode :- Summary "Add with Query to corpus endpoint"
          :> "corpus"
          :> Capture "corpus_id" CorpusId
          :> "query"
          :> AsyncJobs JobLog '[JSON] WithQuery JobLog
          :> NamedRoutes (AsyncJobs JobLog '[JSON] WithQuery JobLog)
          } deriving Generic
          src/Gargantext/API/Routes/Named/Count.hs
          View file @ 85353a92
          ......@@ -10,7 +10,7 @@ module Gargantext.API.Routes.Named.Count (
          import GHC.Generics
          import Servant
          import Gargantext.API.Count as X hiding (CountAPI)
          import Gargantext.API.Count.Types as X
          newtype CountAPI mode = CountAPI
          ......
          src/Gargantext/API/Routes/Named/Document.hs
          View file @ 85353a92
          ......@@ -6,49 +6,38 @@ module Gargantext.API.Routes.Named.Document (
          DocumentsFromWriteNodesAPI(..)
          , DocumentUploadAPI(..)
          , DocumentExportAPI(..)
          , DocumentExportEndpoints(..)
          -- * API types
          , Params(..)
          , DocumentUpload(..)
          -- * functions and lenses
          , du_title
          , du_sources
          , du_language
          , du_date
          , du_authors
          , du_abstract
          ) where
          import Control.Lens
          import Data.Aeson
          import Data.Swagger hiding (fieldLabelModifier)
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.API.Node.Document.Export.Types
          import Gargantext.Core
          import Gargantext.Core.Text.List.Social
          import Gargantext.Core.Utils.Prefix
          import Gargantext.API.Node.DocumentsFromWriteNodes.Types ( Params(..) )
          import Gargantext.API.Node.DocumentUpload.Types ( DocumentUpload(..), )
          import Gargantext.Utils.Servant (ZIP)
          import Prelude
          import Servant
          newtype DocumentExportAPI mode = DocumentExportAPI
          { documentExportAPI ::
          mode :- Summary "Document Export"
          :> "export"
          :> ( "json"
          :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
          :<|> "json.zip"
          :> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
          :<|> "csv"
          :> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text) )
          { documentExportAPI :: mode :- Summary "Document Export" :> "export" :> NamedRoutes DocumentExportEndpoints
          } deriving Generic
          data DocumentExportEndpoints mode = DocumentExportEndpoints
          { exportJSONEp :: mode :- "json"
          :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
          , exportJSONZipEp :: mode :- "json.zip"
          :> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
          , exportCSVEp :: mode :- "csv"
          :> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text)
          } deriving Generic
          newtype DocumentsFromWriteNodesAPI mode = DocumentsFromWriteNodesAPI
          { docFromWriteNodesEp :: mode :- Summary " Documents from Write nodes."
          :> AsyncJobs JobLog '[JSON] Params JobLog
          :> NamedRoutes (AsyncJobs JobLog '[JSON] Params JobLog)
          } deriving Generic
          ......@@ -57,61 +46,5 @@ newtype DocumentUploadAPI mode = DocumentUploadAPI
          :> "document"
          :> "upload"
          :> "async"
          :> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
          :> NamedRoutes (AsyncJobs JobLog '[JSON] DocumentUpload JobLog)
          } deriving Generic
          data Params = Params
          { id :: Int
          , paragraphs :: Text
          , lang :: Lang
          , selection :: FlowSocialListWith
          }
          deriving (Generic, Show)
          data DocumentUpload = DocumentUpload
          { _du_abstract :: Text
          , _du_authors :: Text
          , _du_sources :: Text
          , _du_title :: Text
          , _du_date :: Text
          , _du_language :: Text
          }
          deriving Generic
          --
          -- instances
          --
          instance FromJSON Params where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON Params where
          toJSON = genericToJSON defaultOptions
          instance ToSchema Params
          $(makeLenses ''DocumentUpload)
          instance ToSchema DocumentUpload
          instance FromJSON DocumentUpload
          where
          parseJSON = genericParseJSON
          ( defaultOptions { sumEncoding = ObjectWithSingleField
          , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
          , omitNothingFields = True
          }
          )
          instance ToJSON DocumentUpload
          where
          toJSON = genericToJSON
          ( defaultOptions { sumEncoding = ObjectWithSingleField
          , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
          , omitNothingFields = True
          }
          )
          src/Gargantext/API/Routes/Named/EKG.hs 0 → 100644
          View file @ 85353a92
          {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE DeriveGeneric #-}
          module Gargantext.API.Routes.Named.EKG (
          -- * Routes types
          EkgAPI(..)
          ) where
          import Data.Text (Text)
          import GHC.Generics
          import Servant
          import System.Metrics.Json qualified as J
          -- Mimics https://github.com/tibbe/ekg/blob/master/System/Remote/Snap.hs#L98
          newtype EkgAPI mode = EkgAPI
          { ekgAPI :: mode :- "ekg" :> ( "api" :> ( Get '[JSON] J.Sample :<|>
          CaptureAll "segments" Text :> Get '[JSON] J.Value
          ) :<|> Raw )
          } deriving Generic
          src/Gargantext/API/Routes/Named/File.hs
          View file @ 85353a92
          ......@@ -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
          View file @ 85353a92
          {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE DeriveGeneric #-}
          module Gargantext.API.Routes.Named.FrameCalc where
          module Gargantext.API.Routes.Named.FrameCalc (
          -- * Routes types
          FrameCalcAPI(..)
          ) where
          import Servant
          import GHC.Generics
          import Gargantext.API.Node.FrameCalcUpload (FrameCalcUpload)
          import Gargantext.API.Node.FrameCalcUpload.Types (FrameCalcUpload)
          import Gargantext.API.Admin.Orchestrator.Types
          data FrameCalcAPI mode = FrameCalcAPI
          newtype FrameCalcAPI mode = FrameCalcAPI
          { frameCalcUploadEp :: mode :- Summary " FrameCalc upload"
          :> "add"
          :> "framecalc"
          :> "async"
          :> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
          :> NamedRoutes (AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog)
          } deriving Generic
          src/Gargantext/API/Routes/Named/List.hs
          View file @ 85353a92
          {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE DeriveGeneric #-}
          module Gargantext.API.Routes.Named.List where
          module Gargantext.API.Routes.Named.List (
          -- * Routes types
          GETAPI(..)
          , ListEndpoints(..)
          , JSONAPI(..)
          , CSVAPI(..)
          ) where
          import Data.Text (Text)
          import GHC.Generics
          ......@@ -16,14 +22,16 @@ newtype GETAPI mode = GETAPI
          { getListEp :: mode :- Summary "Get List"
          :> "lists"
          :> Capture "listId" ListId
          :> ( "json"
          :> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
          :<|> "json.zip"
          :> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
          :<|> "csv"
          :> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap) )
          :> NamedRoutes ListEndpoints
          } deriving Generic
          data ListEndpoints mode = ListEndpoints
          { listJSONEp :: mode :- "json"
          :> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
          , listJSONZipEp :: mode :- "json.zip"
          :> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
          , listCSVEp :: mode :- "csv" :> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap)
          } deriving Generic
          newtype JSONAPI mode = JSONAPI
          { updateListJSONEp :: mode :- Summary "Update List"
          ......@@ -32,7 +40,7 @@ newtype JSONAPI mode = JSONAPI
          :> "add"
          :> "form"
          :> "async"
          :> AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog
          :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog)
          } deriving Generic
          ......@@ -44,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
          View file @ 85353a92
          ......@@ -7,7 +7,7 @@ module Gargantext.API.Routes.Named.Node (
          , PostNodeAPI(..)
          , ChildrenAPI(..)
          , NodeNodeAPI(..)
          , PostNodeAsync(..)
          , PostNodeAsyncAPI(..)
          , CatAPI(..)
          , UpdateAPI(..)
          , MoveAPI(..)
          ......@@ -16,6 +16,7 @@ module Gargantext.API.Routes.Named.Node (
          , Pairs(..)
          , Roots(..)
          , NodesAPI(..)
          , ScoreAPI(..)
          -- * API types (might appear in the routes)
          , Charts(..)
          ......@@ -27,9 +28,6 @@ module Gargantext.API.Routes.Named.Node (
          , UpdateNodeParams(..)
          ) where
          import Data.Aeson
          import Data.Swagger
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
          import Gargantext.API.Auth.PolicyCheck ( PolicyChecked )
          ......@@ -42,20 +40,15 @@ import Gargantext.API.Routes.Named.Viz
          import Gargantext.API.Routes.Named.Search
          import Gargantext.API.Routes.Named.Share as Share
          import Gargantext.API.Routes.Named.Table
          import Gargantext.API.Routes.Named.Tree
          import Gargantext.Core.Methods.Similarities
          import Gargantext.Core.Text.Ngrams
          import Gargantext.API.Node.Types ( RenameNode(..), NodesToScore(..), NodesToCategory(..) )
          import Gargantext.API.Node.New.Types ( PostNode(..) )
          import Gargantext.API.Node.Update.Types ( UpdateNodeParams(..), Charts(..), Granularity(..), Method(..) )
          import Gargantext.Core.Types
          import Gargantext.Core.Types.Query
          import Gargantext.Core.Viz.Graph.Tools
          import Gargantext.Core.Viz.Graph.Types hiding (Node)
          import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
          import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
          import Gargantext.Database.Query.Facet.Types ( FacetDoc, OrderBy(..) )
          import Prelude
          import Servant
          import Test.QuickCheck
          import Web.FormUrlEncoded (FromForm, ToForm)
          -------------------------------------------------------------------
          -- | Node API Types management
          ......@@ -72,11 +65,11 @@ import Web.FormUrlEncoded (FromForm, ToForm)
          -- CanFavorite
          -- CanMoveToTrash
          data NodeAPI mode a = NodeAPI
          data NodeAPI a mode = NodeAPI
          { nodeNodeAPI :: mode :- PolicyChecked (NamedRoutes (NodeNodeAPI a))
          , renameAPI :: mode :- "rename" :> NamedRoutes RenameAPI
          , postNodeAPI :: mode :- NamedRoutes PostNodeAPI -- TODO move to children POST
          , postNodeAsync :: mode :- NamedRoutes PostNodeAsync
          , postNodeAsyncAPI :: mode :- NamedRoutes PostNodeAsyncAPI
          , frameCalcUploadAPI :: mode :- NamedRoutes FrameCalcAPI
          , putEp :: mode :- ReqBody '[JSON] a :> Put '[JSON] Int
          , updateAPI :: mode :- "update" :> NamedRoutes UpdateAPI
          ......@@ -88,15 +81,15 @@ data NodeAPI mode a = NodeAPI
          , scoreAPI :: mode :- "score" :> NamedRoutes ScoreAPI
          , searchAPI :: mode :- "search" :> NamedRoutes (SearchAPI SearchResult)
          , shareAPI :: mode :- "share" :> NamedRoutes ShareNode
          -- Pairing utilities
          ---- Pairing utilities
          , pairWithEp :: mode :- "pairwith" :> NamedRoutes PairWith
          , pairsEp :: mode :- "pairs" :> NamedRoutes Pairs
          , pairingEp :: mode :- "pairing" :> NamedRoutes PairingAPI
          -- VIZ
          ---- VIZ
          , scatterAPI :: mode :- "metrics" :> NamedRoutes ScatterAPI
          , charAPI :: mode :- "chart" :> NamedRoutes ChartAPI
          , chartAPI :: mode :- "chart" :> NamedRoutes ChartAPI
          , pieAPI :: mode :- "pie" :> NamedRoutes PieAPI
          , treeAPI :: mode :- "tree" :> NamedRoutes NodeTreeAPI
          , treeAPI :: mode :- "tree" :> NamedRoutes TreeAPI
          , phyloAPI :: mode :- "phylo" :> NamedRoutes PhyloAPI
          , moveAPI :: mode :- "move" :> NamedRoutes MoveAPI
          , unpublishEp :: mode :- "unpublish" :> NamedRoutes Share.Unpublish
          ......@@ -124,11 +117,11 @@ newtype PostNodeAPI mode = PostNodeAPI
          newtype ChildrenAPI a mode = ChildrenAPI
          { summaryChildrenEp :: Summary " Summary children"
          :> QueryParam "type" NodeType
          :> QueryParam "offset" Offset
          :> QueryParam "limit" Limit
          :> Get '[JSON] (NodeTableResult a)
          { summaryChildrenEp :: mode :- Summary " Summary children"
          :> QueryParam "type" NodeType
          :> QueryParam "offset" Offset
          :> QueryParam "limit" Limit
          :> Get '[JSON] (NodeTableResult a)
          } deriving Generic
          ......@@ -137,10 +130,10 @@ newtype NodeNodeAPI a mode = NodeNodeAPI
          } deriving Generic
          newtype PostNodeAsync mode = PostNodeAsync
          newtype PostNodeAsyncAPI mode = PostNodeAsyncAPI
          { postNodeAsyncEp :: mode :- Summary "Post Node"
          :> "async"
          :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
          :> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog)
          } deriving Generic
          ......@@ -153,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
          ......@@ -205,81 +198,3 @@ data Roots mode = Roots
          newtype NodesAPI mode = NodesAPI
          { deleteNodeEp :: mode :- Delete '[JSON] Int
          } deriving Generic
          --
          -- API types (might appears in the routes)
          --
          newtype RenameNode = RenameNode { r_name :: Text }
          deriving Generic
          data NodesToCategory = NodesToCategory
          { ntc_nodesId :: [NodeId]
          , ntc_category :: Int
          } deriving Generic
          data PostNode = PostNode
          { pn_name :: Text
          , pn_typename :: NodeType
          } deriving Generic
          data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
          | UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
          , methodGraphClustering :: !PartitionMethod
          , methodGraphBridgeness :: !BridgenessMethod
          , methodGraphEdgesStrength :: !Strength
          , methodGraphNodeType1 :: !NgramsType
          , methodGraphNodeType2 :: !NgramsType
          }
          | UpdateNodeParamsTexts { methodTexts :: !Granularity }
          | UpdateNodeParamsBoard { methodBoard :: !Charts }
          | LinkNodeReq { nodeType :: !NodeType
          , id :: !NodeId }
          | UpdateNodePhylo { config :: !PhyloSubConfigAPI }
          deriving Generic
          data Method = Basic | Advanced | WithModel
          deriving (Generic, Eq, Ord, Enum, Bounded)
          data Granularity = NewNgrams | NewTexts | Both
          deriving (Generic, Eq, Ord, Enum, Bounded)
          data Charts = Sources | Authors | Institutes | Ngrams | All
          deriving (Generic, Eq, Ord, Enum, Bounded)
          data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
          , nts_score :: Int
          }
          deriving (Generic)
          --
          -- Instances
          --
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON PostNode
          instance ToJSON PostNode
          instance ToSchema PostNode
          instance FromForm PostNode
          instance ToForm PostNode
          instance Arbitrary PostNode where
          arbitrary = elements [PostNode "Node test" NodeCorpus]
          -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON NodesToScore
          instance ToJSON NodesToScore
          instance ToSchema NodesToScore
          src/Gargantext/API/Routes/Named/Private.hs
          View file @ 85353a92
          {-# LANGUAGE TypeOperators #-}
          {-# LANGUAGE DeriveGeneric #-}
          {-# LANGUAGE KindSignatures #-}
          {-# LANGUAGE TypeFamilies #-}
          module Gargantext.API.Routes.Named.Private (
          -- * Routes types
          GargPrivateAPI
          GargPrivateAPI(..)
          , MkProtectedAPI
          , GargPrivateAPI'(..)
          , GargAdminAPI(..)
          , NodeEndpoint(..)
          , NodeAPIEndpoint(..)
          , MembersAPI(..)
          , IsGenericNodeRoute(..)
          ) where
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.API.Admin.Auth.Types
          ......@@ -20,7 +25,6 @@ import Gargantext.API.Routes.Named.Context
          import Gargantext.API.Routes.Named.Corpus
          import Gargantext.API.Routes.Named.Count
          import Gargantext.API.Routes.Named.Document
          import Gargantext.API.Routes.Named.Metrics
          import Gargantext.API.Routes.Named.Node
          import Gargantext.API.Routes.Named.List qualified as List
          import Gargantext.API.Routes.Named.Share
          ......@@ -32,6 +36,8 @@ import Gargantext.Database.Admin.Types.Hyperdata.Corpus
          import Gargantext.Database.Admin.Types.Node
          import Servant.API
          import Servant.Auth qualified as SA
          import Data.Kind
          import GHC.TypeLits
          type MkProtectedAPI private = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> private
          ......@@ -44,13 +50,11 @@ newtype GargPrivateAPI mode = GargPrivateAPI
          data GargPrivateAPI' mode = GargPrivateAPI'
          { gargAdminAPI :: mode :- NamedRoutes GargAdminAPI
          , nodeEp :: mode :- NamedRoutes NodeEndpoint
          , contextEp :: mode :- "context" :> Summary "Node endpoint"
          , nodeEp :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataAny)
          , contextEp :: mode :- "context" :> Summary "Context endpoint"
          :> Capture "node_id" ContextId
          :> NamedRoutes (ContextAPI HyperdataAny)
          , corpusNodeAPI :: mode :- "corpus" :> Summary "Corpus endpoint"
          :> Capture "corpus_id" CorpusId
          :> NamedRoutes (NodeAPI HyperdataCorpus)
          , corpusNodeAPI :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataCorpus)
          , corpusNodeNodeAPI :: mode :- "corpus" :> Summary "Corpus endpoint"
          :> Capture "node1_id" NodeId
          :> "document"
          ......@@ -58,9 +62,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
          :> NamedRoutes (NodeNodeAPI HyperdataAny)
          , corpusExportAPI :: mode :- "corpus" :> Capture "node_id" CorpusId
          :> NamedRoutes CorpusExportAPI
          , annuaireEp :: mode :- "annuaire" :> Summary "Annuaire endpoint"
          :> Capture "annuaire_id" AnnuaireId
          :> NamedRoutes (NodeAPI HyperdataAnnuaire)
          , annuaireEp :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataAnnuaire)
          , contactAPI :: mode :- "annuaire" :> Summary "Contact endpoint"
          :> Capture "annuaire_id" NodeId
          :> NamedRoutes ContactAPI
          ......@@ -70,6 +72,8 @@ data GargPrivateAPI' mode = GargPrivateAPI'
          :> NamedRoutes TableNgramsAPI
          , documentExportAPI :: mode :- "texts" :> Capture "node_id" DocId
          :> NamedRoutes DocumentExportAPI
          , phyloExportAPI :: mode :- "phylo" :> Capture "node_id" DocId
          :> NamedRoutes PhyloExportAPI
          , countAPI :: mode :- "count" :> Summary "Count endpoint"
          :> ReqBody '[JSON] Query
          :> NamedRoutes CountAPI
          ......@@ -78,7 +82,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
          :> NamedRoutes GraphAPI
          , treeAPI :: mode :- "tree" :> Summary "Tree endpoint"
          :> Capture "tree_id" NodeId
          :> PolicyChecked (NamedRoutes TreeAPI)
          :> PolicyChecked (NamedRoutes NodeTreeAPI)
          , treeFlatAPI :: mode :- "treeflat" :> Summary "Flat tree endpoint"
          :> Capture "tree_id" NodeId
          :> NamedRoutes TreeFlatAPI
          ......@@ -99,15 +103,34 @@ data GargAdminAPI mode = GargAdminAPI
          :> NamedRoutes NodesAPI
          } deriving Generic
          data NodeEndpoint mode = NodeEndpoint
          { nodeEndpointAPI :: mode :- "node" :> Summary "Node endpoint"
          :> Capture "node_id" NodeId
          :> NamedRoutes (NodeAPI HyperdataAny)
          class IsGenericNodeRoute a where
          type family TyToSubPath (a :: Type) :: Symbol
          type family TyToCapture (a :: Type) :: Symbol
          type family TyToSummary (a :: Type) :: Type
          instance IsGenericNodeRoute HyperdataAny where
          type instance TyToSubPath HyperdataAny = "node"
          type instance TyToCapture HyperdataAny = "node_id"
          type instance TyToSummary HyperdataAny = Summary "Node endpoint"
          instance IsGenericNodeRoute HyperdataCorpus where
          type instance TyToSubPath HyperdataCorpus = "corpus"
          type instance TyToCapture HyperdataCorpus = "corpus_id"
          type instance TyToSummary HyperdataCorpus = Summary "Corpus endpoint"
          instance IsGenericNodeRoute HyperdataAnnuaire where
          type instance TyToSubPath HyperdataAnnuaire = "annuaire"
          type instance TyToCapture HyperdataAnnuaire = "annuaire_id"
          type instance TyToSummary HyperdataAnnuaire = Summary "Annuaire endpoint"
          newtype NodeAPIEndpoint a mode = NodeAPIEndpoint
          { nodeEndpointAPI :: mode :- TyToSubPath a
          :> TyToSummary a
          :> Capture (TyToCapture a) NodeId
          :> NamedRoutes (NodeAPI a)
          } deriving Generic
          data MembersAPI mode = MembersAPI
          newtype MembersAPI mode = MembersAPI
          { getMembersEp :: mode :- Get '[JSON] [Text]
          }
          } deriving Generic
          src/Gargantext/API/Routes/Named/Public.hs
          View file @ 85353a92
          {-# LANGUAGE DeriveGeneric #-}
          {-# LANGUAGE TypeOperators #-}
          module Gargantext.API.Routes.Named.Public where
          module Gargantext.API.Routes.Named.Public (
          -- * Routes types
          GargPublicAPI(..)
          , HomeAPI(..)
          , NodeAPI(..)
          ) where
          import GHC.Generics
          import Gargantext.API.Public qualified as Public
          import Gargantext.API.Public.Types qualified as Public
          import Gargantext.API.Routes.Named.File
          import Gargantext.Database.Admin.Types.Node ( NodeId )
          import Servant.API
          data GargPublicAPI mode = GargPublicAPI
          { publicHomeAPI :: mode :- NamedRoutes HomeAPI
          , publicNodeAPI :: mode :- NamedRoutes NodeAPI
          } deriving Generic
          data HomeAPI mode = HomeAPI
          { homeEp :: mode :- Summary "Public Home API" :> Get '[JSON] [Public.PublicData]
          } deriving Generic
          data NodeAPI mode = NodeAPI
          { nodeEp :: mode :- Summary "Public Node API" :> Capture "node" NodeId :> "file" :> NamedRoutes FileAPI
          } deriving Generic
          src/Gargantext/API/Routes/Named/Search.hs
          View file @ 85353a92
          ......@@ -12,23 +12,16 @@ module Gargantext.API.Routes.Named.Search (
          ) where
          import Data.Aeson
          import Data.Swagger
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.Core.Text.Corpus.Query (RawQuery (..))
          import Gargantext.API.Search.Types ( SearchQuery(..), SearchType(..), SearchResult(..), SearchResultTypes(..) )
          import Gargantext.Core.Types.Query (Limit, Offset)
          import Gargantext.Core.Types.Search
          import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
          import Gargantext.Database.Query.Facet
          import Prelude
          import Servant
          import Test.QuickCheck
          -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
          -- TODO-EVENTS: No event, this is a read-only query.
          data SearchAPI results mode = SearchAPI
          newtype SearchAPI results mode = SearchAPI
          { searchEp :: mode :- Summary "Search endpoint"
          :> ReqBody '[JSON] SearchQuery
          :> QueryParam "offset" Offset
          ......@@ -36,79 +29,3 @@ data SearchAPI results mode = SearchAPI
          :> QueryParam "order" OrderBy
          :> Post '[JSON] results
          } deriving Generic
          data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
          deriving Generic
          data SearchQuery = SearchQuery
          { query :: !RawQuery
          , expected :: !SearchType
          } deriving Generic
          newtype SearchResult =
          SearchResult { result :: SearchResultTypes }
          deriving Generic
          data SearchResultTypes =
          SearchResultDoc { docs :: ![Row] }
          | SearchResultContact { contacts :: ![Row] }
          | SearchNoResult { message :: !Text }
          deriving Generic
          --
          -- instances
          --
          instance FromJSON SearchResult where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON SearchResult where
          toJSON = genericToJSON defaultOptions
          instance ToSchema SearchResult
          instance Arbitrary SearchResult where
          arbitrary = SearchResult <$> arbitrary
          instance FromJSON SearchResultTypes where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
          instance ToJSON SearchResultTypes where
          toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
          instance Arbitrary SearchResultTypes where
          arbitrary = do
          srd <- SearchResultDoc <$> arbitrary
          src <- SearchResultContact <$> arbitrary
          srn <- pure $ SearchNoResult "No result because.."
          elements [srd, src, srn]
          instance ToSchema SearchResultTypes where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
          instance FromJSON SearchQuery where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON SearchQuery where
          toJSON = genericToJSON defaultOptions
          instance ToSchema SearchQuery
          instance Arbitrary SearchQuery where
          arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
          instance FromJSON SearchType where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
          instance ToJSON SearchType where
          toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
          instance ToSchema SearchType
          instance Arbitrary SearchType where
          arbitrary = elements [SearchDoc, SearchContact]
          src/Gargantext/API/Routes/Named/Share.hs
          View file @ 85353a92
          ......@@ -11,15 +11,13 @@ module Gargantext.API.Routes.Named.Share (
          , ShareNodeParams(..)
          ) where
          import Data.Aeson
          import Data.Swagger
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.API.Node.Share.Types ( ShareNodeParams (..) )
          import Gargantext.Database.Admin.Types.Node
          import Gargantext.Utils.Aeson qualified as GUA
          import Prelude
          import Servant
          import Test.QuickCheck
          newtype ShareURL mode = ShareURL
          { shareUrlEp :: mode :- Summary "Fetch URL for sharing a node"
          ......@@ -39,25 +37,3 @@ newtype ShareNode mode = ShareNode
          newtype Unpublish mode = Unpublish
          { unpublishEp :: mode :- Summary " Unpublish Node" :> Capture "node_id" NodeId :> Put '[JSON] Int
          } deriving Generic
          --
          -- API Types
          --
          data ShareNodeParams = ShareTeamParams { username :: Text }
          | SharePublicParams { node_id :: NodeId }
          deriving (Generic)
          --
          -- Instances
          --
          -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
          instance FromJSON ShareNodeParams where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
          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/Routes/Named/Table.hs
          View file @ 85353a92
          ......@@ -18,23 +18,20 @@ module Gargantext.API.Routes.Named.Table (
          , FacetTableResult
          ) where
          import Data.Aeson.TH
          import Data.Swagger
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.API.Admin.Orchestrator.Types
          import Gargantext.API.HashedResponse
          import Gargantext.API.Ngrams.Types (TabType(..), UpdateTableNgramsCharts, Version, QueryParamR, Versioned, VersionedWithCount, NgramsTable, NgramsTablePatch)
          import Gargantext.API.Ngrams.Types qualified as Ngrams
          import Gargantext.API.Table.Types ( TableQuery(..), FacetTableResult )
          import Gargantext.Core.Text.Corpus.Query (RawQuery)
          import Gargantext.Core.Types (TableResult(..))
          import Gargantext.Core.Types.Main (ListType)
          import Gargantext.Core.Types.Query
          import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
          import Gargantext.Database.Admin.Types.Node (ListId)
          import Gargantext.Database.Query.Facet.Types
          import Gargantext.Database.Query.Facet.Types qualified as Facet
          import Prelude
          import Servant
          import Test.QuickCheck
          data TableAPI mode = TableAPI
          ......@@ -42,7 +39,7 @@ data TableAPI mode = TableAPI
          :> QueryParam "tabType" TabType
          :> QueryParam "limit" Limit
          :> QueryParam "offset" Offset
          :> QueryParam "orderBy" OrderBy
          :> QueryParam "orderBy" Facet.OrderBy
          :> QueryParam "query" RawQuery
          :> QueryParam "year" Text
          :> Get '[JSON] (HashedResponse FacetTableResult)
          ......@@ -65,7 +62,7 @@ data TableNgramsAPI mode = TableNgramsAPI
          } deriving Generic
          data TableNgramsApiGet mode = TableNgramsApiGet
          newtype TableNgramsApiGet mode = TableNgramsApiGet
          { getNgramsTableEp :: mode :- Summary " Table Ngrams API Get"
          :> QueryParamR "ngramsType" TabType
          :> QueryParamR "list" ListId
          ......@@ -74,13 +71,13 @@ data TableNgramsApiGet mode = TableNgramsApiGet
          :> QueryParam "listType" ListType
          :> QueryParam "minTermSize" MinSize
          :> QueryParam "maxTermSize" MaxSize
          :> QueryParam "orderBy" OrderBy
          :> QueryParam "orderBy" Ngrams.OrderBy
          :> QueryParam "search" Text
          :> Get '[JSON] (VersionedWithCount NgramsTable)
          } deriving Generic
          data TableNgramsApiPut mode = TableNgramsApiPut
          newtype TableNgramsApiPut mode = TableNgramsApiPut
          { putNgramsTableEp :: mode :- Summary " Table Ngrams API Change"
          :> QueryParamR "ngramsType" TabType
          :> QueryParamR "list" ListId
          ......@@ -89,7 +86,7 @@ data TableNgramsApiPut mode = TableNgramsApiPut
          } deriving Generic
          data RecomputeScoresNgramsApiGet mode = RecomputeScoresNgramsApiGet
          newtype RecomputeScoresNgramsApiGet mode = RecomputeScoresNgramsApiGet
          { recomputeNgramsEp :: mode :- Summary " Recompute scores for ngrams table"
          :> QueryParamR "ngramsType" TabType
          :> QueryParamR "list" ListId
          ......@@ -97,7 +94,7 @@ data RecomputeScoresNgramsApiGet mode = RecomputeScoresNgramsApiGet
          } deriving Generic
          data TableNgramsApiGetVersion mode = TableNgramsApiGetVersion
          newtype TableNgramsApiGetVersion mode = TableNgramsApiGetVersion
          { getTableNgramsVersion :: mode :- Summary " Table Ngrams API Get Version"
          :> QueryParamR "ngramsType" TabType
          :> QueryParamR "list" ListId
          ......@@ -110,32 +107,5 @@ data TableNgramsAsyncAPI mode = TableNgramsAsyncAPI
          :> "async"
          :> "charts"
          :> "update"
          :> AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog
          :> NamedRoutes (AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog)
          } deriving Generic
          data TableQuery = TableQuery
          { tq_offset :: Offset
          , tq_limit :: Limit
          , tq_orderBy :: OrderBy
          , tq_view :: TabType
          , tq_query :: RawQuery
          } deriving Generic
          type FacetTableResult = TableResult FacetDoc
          --
          -- instances
          --
          $(deriveJSON (unPrefix "tq_") ''TableQuery)
          instance ToSchema TableQuery where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
          instance Arbitrary TableQuery where
          arbitrary = elements [TableQuery { tq_offset = 0
          , tq_limit = 10
          , tq_orderBy = DateAsc
          , tq_view = Docs
          , tq_query = "electrodes" }]
          src/Gargantext/API/Routes/Named/Viz.hs
          View file @ 85353a92
          ......@@ -9,28 +9,26 @@ module Gargantext.API.Routes.Named.Viz (
          , GraphAPI(..)
          , GraphAsyncAPI(..)
          , GraphVersionsAPI(..)
          , PhyloExportAPI(..)
          , PhyloExportEndpoints(..)
          -- * API types (appears in the routes)
          , PhyloData(..)
          , GraphVersions(..)
          ) where
          import Data.Aeson
          import Data.Swagger
          import Data.Aeson ( Value )
          import Data.Text (Text)
          import GHC.Generics
          import Gargantext.API.Admin.Orchestrator.Types ( JobLog )
          import Gargantext.API.Viz.Types (PhyloData(..))
          import Gargantext.Core.Types
          import Gargantext.Core.Types.Phylo
          import Gargantext.Core.Viz.Graph.Types
          import Gargantext.Core.Viz.LegacyPhylo (Level)
          import Gargantext.Core.Viz.Phylo
          import Gargantext.Core.Viz.Phylo.Legacy.LegacyMain (MinSizeBranch)
          import Prelude
          import Servant
          import Servant.Job.Async (AsyncJobsAPI)
          import Servant.XML.Conduit (XML)
          import Test.QuickCheck
          data PhyloAPI mode = PhyloAPI
          ......@@ -52,6 +50,8 @@ newtype PostPhylo mode = PostPhylo
          } deriving Generic
          -- | There is no Delete specific API for Graph since it can be deleted
          -- as simple Node.
          data GraphAPI mode = GraphAPI
          { getGraphEp :: mode :- Get '[JSON] HyperdataGraphAPI
          , getGraphAsyncEp :: mode :- "async" :> NamedRoutes GraphAsyncAPI
          ......@@ -73,50 +73,11 @@ data GraphVersionsAPI mode = GraphVersionsAPI
          , recomputeGraphVersionEp :: mode :- Summary "Recompute graph version" :> Post '[JSON] Graph
          } deriving Generic
          newtype PhyloExportAPI mode = PhyloExportAPI
          { phyloExportEndpoints :: mode :- "export" :> NamedRoutes PhyloExportEndpoints
          } deriving Generic
          data PhyloData = PhyloData { pd_corpusId :: NodeId
          , pd_listId :: NodeId
          , pd_data :: GraphData
          , pd_config :: PhyloConfig
          }
          deriving (Generic, Show, Eq)
          data GraphVersions = GraphVersions
          { gv_graph :: Maybe Int
          , gv_repo :: Int
          } deriving (Show, Generic)
          --
          -- instances
          --
          instance ToJSON PhyloData where
          toJSON PhyloData{..} =
          object [
          "pd_corpusId" .= toJSON pd_corpusId
          , "pd_listId" .= toJSON pd_listId
          , "pd_data" .= toJSON pd_data
          , "pd_config" .= toJSON pd_config
          ]
          instance FromJSON PhyloData where
          parseJSON = withObject "PhyloData" $ \o -> do
          pd_corpusId <- o .: "pd_corpusId"
          pd_listId <- o .: "pd_listId"
          pd_data <- o .: "pd_data"
          pd_config <- o .: "pd_config"
          pure $ PhyloData{..}
          instance Arbitrary PhyloData where
          arbitrary = PhyloData <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
          instance ToSchema PhyloData
          instance FromJSON GraphVersions
          instance ToJSON GraphVersions
          instance ToSchema GraphVersions
          data PhyloExportEndpoints mode = PhyloExportEndpoints
          { exportPhyloJSONEp :: mode :- "json" :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Value)
          , exportPhyloDotEp :: mode :- "dot" :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Text)
          } deriving Generic
          src/Gargantext/API/Routes/Types.hs
          View file @ 85353a92
          ......@@ -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/Search.hs
          View file @ 85353a92
          ......@@ -19,47 +19,33 @@ Count API part of Gargantext.
          module Gargantext.API.Search
          where
          import Data.Aeson hiding (defaultTaggedObject)
          import Data.Swagger hiding (fieldLabelModifier, Contact)
          import Data.Text qualified as T
          import Gargantext.API.Prelude (GargServer)
          import Gargantext.API.Prelude (IsGargServer)
          import Gargantext.API.Routes.Named.Search qualified as Named
          import Gargantext.API.Search.Types
          import Gargantext.Core.Text.Corpus.Query (RawQuery (..), parseQuery)
          import Gargantext.Core.Types.Query (Limit, Offset)
          import Gargantext.Core.Types.Search
          import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
          import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
          import Gargantext.Database.Action.Search
          import Gargantext.Database.Admin.Types.Node hiding (DEBUG)
          import Gargantext.Database.Query.Facet
          import Gargantext.Prelude
          import Gargantext.System.Logging
          import Gargantext.Utils.Aeson (defaultTaggedObject)
          import Servant
          import Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary
          import Servant.Server.Generic (AsServerT)
          -----------------------------------------------------------------------
          -- TODO-ACCESS: CanSearch? or is it part of CanGetNode
          -- TODO-EVENTS: No event, this is a read-only query.
          type API results = Summary "Search endpoint"
          :> ReqBody '[JSON] SearchQuery
          :> QueryParam "offset" Offset
          :> QueryParam "limit" Limit
          :> QueryParam "order" OrderBy
          :> Post '[JSON] results
          -----------------------------------------------------------------------
          -- | Api search function
          api :: NodeId -> GargServer (API SearchResult)
          api nId (SearchQuery rawQuery SearchDoc) o l order = do
          case parseQuery rawQuery of
          api :: IsGargServer env err m => NodeId -> Named.SearchAPI SearchResult (AsServerT m)
          api nId = Named.SearchAPI $ \query o l order -> case query of
          (SearchQuery rawQuery SearchDoc) -> case parseQuery rawQuery of
          Left err -> pure $ SearchResult $ SearchNoResult (T.pack err)
          Right q -> do
          $(logLocM) DEBUG $ T.pack "New search started with query = " <> (getRawQuery rawQuery)
          SearchResult <$> SearchResultDoc
          <$> map (toRow nId)
          <$> searchInCorpus nId False q o l order
          api nId (SearchQuery rawQuery SearchContact) o l order = do
          case parseQuery rawQuery of
          (SearchQuery rawQuery SearchContact) -> case parseQuery rawQuery of
          Left err -> pure $ SearchResult $ SearchNoResult (T.pack err)
          Right q -> do
          -- printDebug "isPairedWith" nId
          ......@@ -72,81 +58,5 @@ api nId (SearchQuery rawQuery SearchContact) o l order = do
          <$> SearchResultContact
          <$> map (toRow aId)
          <$> searchInCorpusWithContacts nId aId q o l order
          api _nId (SearchQuery _q SearchDocWithNgrams) _o _l _order = undefined
          -----------------------------------------------------------------------
          -----------------------------------------------------------------------
          -- | Main Types
          -----------------------------------------------------------------------
          data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
          deriving (Generic)
          instance FromJSON SearchType where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
          instance ToJSON SearchType where
          toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
          instance ToSchema SearchType
          instance Arbitrary SearchType where
          arbitrary = elements [SearchDoc, SearchContact]
          -----------------------------------------------------------------------
          data SearchQuery =
          SearchQuery { query :: !RawQuery
          , expected :: !SearchType
          }
          deriving (Generic)
          instance FromJSON SearchQuery where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON SearchQuery where
          toJSON = genericToJSON defaultOptions
          instance ToSchema SearchQuery
          {-
          where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
          -}
          instance Arbitrary SearchQuery where
          arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
          -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
          -----------------------------------------------------------------------
          data SearchResult =
          SearchResult { result :: !SearchResultTypes}
          deriving (Generic)
          instance FromJSON SearchResult where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON SearchResult where
          toJSON = genericToJSON defaultOptions
          instance ToSchema SearchResult
          {-
          where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
          -}
          instance Arbitrary SearchResult where
          arbitrary = SearchResult <$> arbitrary
          data SearchResultTypes =
          SearchResultDoc { docs :: ![Row] }
          | SearchResultContact { contacts :: ![Row] }
          | SearchNoResult { message :: !Text }
          deriving (Generic)
          instance FromJSON SearchResultTypes where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
          instance ToJSON SearchResultTypes where
          toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
          instance Arbitrary SearchResultTypes where
          arbitrary = do
          srd <- SearchResultDoc <$> arbitrary
          src <- SearchResultContact <$> arbitrary
          srn <- pure $ SearchNoResult "No result because.."
          elements [srd, src, srn]
          instance ToSchema SearchResultTypes where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
          (SearchQuery _q SearchDocWithNgrams) -> panicTrace "unimplemented"
          --------------------------------------------------------------------
          src/Gargantext/API/Search/Types.hs 0 → 100644
          View file @ 85353a92
          module Gargantext.API.Search.Types where
          import GHC.Generics
          import Data.Aeson hiding (defaultTaggedObject)
          import Data.Swagger hiding (fieldLabelModifier, Contact)
          import Gargantext.Core.Text.Corpus.Query (RawQuery (..))
          import Gargantext.Core.Types.Search
          import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
          import Gargantext.Prelude
          import Gargantext.Utils.Aeson (defaultTaggedObject)
          import Test.QuickCheck (elements)
          import Test.QuickCheck.Arbitrary
          -----------------------------------------------------------------------
          -----------------------------------------------------------------------
          -- | Main Types
          -----------------------------------------------------------------------
          data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
          deriving (Generic)
          instance FromJSON SearchType where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
          instance ToJSON SearchType where
          toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
          instance ToSchema SearchType
          instance Arbitrary SearchType where
          arbitrary = elements [SearchDoc, SearchContact]
          -----------------------------------------------------------------------
          data SearchQuery =
          SearchQuery { query :: !RawQuery
          , expected :: !SearchType
          }
          deriving (Generic)
          instance FromJSON SearchQuery where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON SearchQuery where
          toJSON = genericToJSON defaultOptions
          instance ToSchema SearchQuery
          {-
          where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
          -}
          instance Arbitrary SearchQuery where
          arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
          -- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
          -----------------------------------------------------------------------
          data SearchResult =
          SearchResult { result :: !SearchResultTypes}
          deriving (Generic)
          instance FromJSON SearchResult where
          parseJSON = genericParseJSON defaultOptions
          instance ToJSON SearchResult where
          toJSON = genericToJSON defaultOptions
          instance ToSchema SearchResult
          {-
          where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
          -}
          instance Arbitrary SearchResult where
          arbitrary = SearchResult <$> arbitrary
          data SearchResultTypes =
          SearchResultDoc { docs :: ![Row] }
          | SearchResultContact { contacts :: ![Row] }
          | SearchNoResult { message :: !Text }
          deriving (Generic)
          instance FromJSON SearchResultTypes where
          parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
          instance ToJSON SearchResultTypes where
          toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
          instance Arbitrary SearchResultTypes where
          arbitrary = do
          srd <- SearchResultDoc <$> arbitrary
          src <- SearchResultContact <$> arbitrary
          srn <- pure $ SearchNoResult "No result because.."
          elements [srd, src, srn]
          instance ToSchema SearchResultTypes where
          declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
          --------------------------------------------------------------------
          src/Gargantext/API/Server.hs → src/Gargantext/API/Server/Named.hs
          View file @ 85353a92
          {-|
          Module : Gargantext.API.Server
          Description : REST API declaration
          Copyright : (c) CNRS, 2017-Present
          License : AGPL + CECILL v3
          Maintainer : team@gargantext.org
          Stability : experimental
          Portability : POSIX
          -}
          {-# LANGUAGE ScopedTypeVariables #-}
          {-# LANGUAGE TemplateHaskell #-}
          module Gargantext.API.Server where
          module Gargantext.API.Server.Named (
          server
          ) where
          import Control.Monad.Catch (catch, throwM)
          import Data.ByteString.Lazy qualified as BL
          ......@@ -25,9 +17,9 @@ import Gargantext.API.Admin.FrontEnd (frontEndServer)
          import Gargantext.API.Auth.PolicyCheck ()
          import Gargantext.API.Errors
          import Gargantext.API.GraphQL qualified as GraphQL
          import Gargantext.API.Prelude (GargM, GargServer)
          import Gargantext.API.Public qualified as Public
          import Gargantext.API.Routes (API, GargVersion, GargAPI)
          import Gargantext.API.Prelude (GargM)
          import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
          import Gargantext.API.Routes.Named
          import Gargantext.API.Swagger (swaggerDoc)
          import Gargantext.API.ThrowAll (serverPrivateGargAPI)
          import Gargantext.Core.AsyncUpdates.Dispatcher qualified as Dispatcher
          ......@@ -37,41 +29,41 @@ import Gargantext.Prelude.Config (gc_url_backend_api)
          import Gargantext.System.Logging (logLocM, LogLevel(..))
          import Paths_gargantext qualified as PG -- cabal magic build module
          import Servant
          import Servant.Server.Generic
          import Servant.Swagger.UI (swaggerSchemaUIServer)
          serverGargAPI :: Text -> ServerT GargAPI (GargM Env BackendInternalError)
          serverGargAPI baseUrl -- orchestrator
          = auth
          :<|> forgotPassword
          :<|> forgotPasswordAsync
          :<|> gargVersion
          :<|> serverPrivateGargAPI
          :<|> Public.api baseUrl
          -- :<|> orchestrator
          serverGargAPI :: Text -> BackEndAPI (AsServerT (GargM Env BackendInternalError))
          serverGargAPI baseUrl
          = BackEndAPI $ MkBackEndAPI $ GargAPIVersion $ GargAPI'
          { gargAuthAPI = AuthAPI auth
          , gargForgotPasswordAPI = forgotPassword
          , gargForgotPasswordAsyncAPI = forgotPasswordAsync
          , gargVersionAPI = gargVersion
          , gargPrivateAPI = serverPrivateGargAPI
          , gargPublicAPI = serverPublicGargAPI baseUrl
          }
          where
          gargVersion :: GargServer GargVersion
          gargVersion = pure (cs $ showVersion PG.version)
          gargVersion :: GargVersion (AsServerT (GargM Env BackendInternalError))
          gargVersion = GargVersion $ pure (cs $ showVersion PG.version)
          -- | Server declarations
          server :: Env -> IO (Server API)
          server env = do
          -- orchestrator <- scrapyOrchestrator env
          pure $ \errScheme ->
          (Dispatcher.d_ws_server $ env ^. env_dispatcher)
          :<|> swaggerSchemaUIServer swaggerDoc
          :<|> hoistServerWithContext
          (Proxy :: Proxy GargAPI)
          (Proxy :: Proxy AuthContext)
          (transformJSON errScheme)
          (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
          :<|> hoistServerWithContext
          (Proxy :: Proxy GraphQL.API)
          (Proxy :: Proxy AuthContext)
          (transformJSONGQL errScheme)
          GraphQL.api
          :<|> frontEndServer
          server :: Env -> API AsServer
          server env =
          API $ \errScheme -> NamedAPI
          { swaggerAPI = swaggerSchemaUIServer swaggerDoc
          , backendAPI = hoistServerWithContext
          (Proxy :: Proxy (NamedRoutes BackEndAPI))
          (Proxy :: Proxy AuthContext)
          (transformJSON errScheme)
          (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
          , graphqlAPI = hoistServerWithContext
          (Proxy :: Proxy GraphQL.API)
          (Proxy :: Proxy AuthContext)
          (transformJSONGQL errScheme)
          GraphQL.api
          , frontendAPI = frontEndServer
          , wsAPI = Dispatcher.d_ws_server $ env ^. env_dispatcher
          }
          where
          transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a
          transformJSON GES_old = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env) . logPanicErrors
          ......
          src/Gargantext/API/Server/Named/EKG.hs 0 → 100644
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Server/Named/Ngrams.hs 0 → 100644
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Server/Named/Private.hs 0 → 100644
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Server/Named/Viz.hs 0 → 100644
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Swagger.hs
          View file @ 85353a92
          ......@@ -21,18 +21,21 @@ import Servant
          import Servant.Swagger
          import qualified Paths_gargantext as PG -- cabal magic build module
          import Gargantext.API.Routes
          import Gargantext.API.Routes.Named qualified as Named
          import Gargantext.Prelude
          backendApiProxy :: Proxy (ToServantApi Named.BackEndAPI)
          backendApiProxy = Proxy
          -- | Swagger Specifications
          swaggerDoc :: Swagger
          swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
          swaggerDoc = toSwagger backendApiProxy
          & info.title .~ "GarganText"
          & info.version .~ (cs $ showVersion PG.version)
          -- & info.base_url ?~ (URL "http://gargantext.org/")
          & info.description ?~ "REST API specifications"
          -- & tags .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
          & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
          & applyTagsFor (subOperations backendApiProxy backendApiProxy)
          ["Gargantext" & description ?~ "Main operations"]
          & info.license ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
          where
          ......
          src/Gargantext/API/Table.hs
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Table/Types.hs 0 → 100644
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/ThrowAll.hs
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Types.hs
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/API/Viz/Types.hs 0 → 100644
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/Core/Viz/Graph/API.hs
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/Core/Viz/Graph/Types.hs
          View file @ 85353a92
          This diff is collapsed.
          src/Gargantext/Core/Viz/Phylo/API.hs
          View file @ 85353a92
          This diff is collapsed.
          stack.yaml
          View file @ 85353a92
          This diff is collapsed.
          test/Test/API/Authentication.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/API/Errors.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/API/Private.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/API/Routes.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/API/Setup.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/API/UpdateList.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/Graph/Distance.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/Offline/JSON.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/Types.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/Utils.hs
          View file @ 85353a92
          This diff is collapsed.
          test/Test/Utils/Crypto.hs
          View file @ 85353a92
          This diff is collapsed.
          Markdown is supported
          0% or
          You are about to add 0 people to the discussion. Proceed with caution.
          Finish editing this message first!
          Please register or to comment