Merge remote-tracking branch 'origin/adinapoli/issue-271' into dev

bin/gargantext-invitations/Main.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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,6 +163,8 @@ library
       Gargantext.API.Routes.Named.Tree
       Gargantext.API.Routes.Named.Viz
       Gargantext.API.Routes.Types
+      Gargantext.API.Types
+      Gargantext.API.Viz.Types
       Gargantext.Core
       Gargantext.Core.Mail.Types
       Gargantext.Core.Methods.Similarities
@@ -288,6 +296,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
@@ -299,17 +308,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
@@ -622,8 +641,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-xml-conduit >= 0.1.0.4
     , simple-reflect ^>= 0.3.3
     , singletons ^>= 2.7

src/Gargantext/API.hs

@@ -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.Database.Prelude qualified as DB
 import Gargantext.Prelude hiding (putStrLn)
 import Gargantext.System.Logging
@@ -166,11 +167,12 @@ makeGargMiddleware crsSettings mode = do
 
 makeApp :: Env -> IO Application
 makeApp env = do
-  serv <- 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
@@ -178,12 +180,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

@@ -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

@@ -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

@@ -34,7 +34,7 @@ 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.API.Prelude (GargM, IsGargServer)
 import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Core.NLP (NLPServerMap, HasNLPServer(..))
 import Gargantext.Core.NodeStory
@@ -322,3 +322,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

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

src/Gargantext/API/Auth/PolicyCheck.hs

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

src/Gargantext/API/Context.hs

@@ -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

@@ -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

+{-# 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/Members.hs

@@ -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

@@ -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/List.hs

@@ -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

@@ -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/Contact.hs

@@ -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

+
+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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

+{-# 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

@@ -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

+
+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

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

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

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

src/Gargantext/API/Node/FrameCalcUpload.hs

@@ -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

+
+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

@@ -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

@@ -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.Database.Action.Flow.Types
 import Gargantext.Database.Action.Node
 import Gargantext.Database.Admin.Types.Node
@@ -35,24 +35,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
@@ -65,19 +48,13 @@ postNode authenticatedUser pId (PostNode nodeName nt) = do
   let userId = authenticatedUser ^. auth_user_id
   mkNodeWithParent nt (Just pId) userId nodeName
 
-------------------------------------------------------------------------
-type PostNodeAsync = Summary "Post Node"
-   :> "async"
-   :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
-
-
 postNodeAsyncAPI
   :: AuthenticatedUser
   -- ^ The logged-in user
   -> NodeId
   -- ^ The target node
-  -> 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

+
+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

@@ -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
+                                          phyloDot
\ No newline at end of file

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

@@ -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

@@ -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

+
+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

@@ -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

@@ -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

@@ -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

+
+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

@@ -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

+
+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/Named.hs

 
 {-# 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 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
+  } 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 +77,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 +96,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

+{-# 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

@@ -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

 {-# 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

@@ -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

@@ -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

@@ -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

+{-# 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

@@ -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

 {-# 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

 {-# 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

@@ -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

 
 {-# 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

 {-# 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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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

+
+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

-{-|
-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.Database.Prelude (hasConfig)
@@ -36,39 +28,40 @@ 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 -> 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
+     }
   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

+{-# LANGUAGE ScopedTypeVariables  #-}
+{-# LANGUAGE TypeApplications     #-}
+{-# LANGUAGE TypeOperators        #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Gargantext.API.Server.Named.EKG where
+
+import Data.HashMap.Strict as HM
+import Data.Text as T
+import Data.Text.IO as T
+import Data.Time.Clock.POSIX (getPOSIXTime)
+import Network.Wai
+import Protolude
+import Servant
+import Servant.Auth
+import Servant.Ekg
+import System.Metrics
+import qualified System.Metrics.Json as J
+import Gargantext.API.Routes.Named.EKG
+import Servant.Server.Generic
+
+
+ekgServer :: FilePath -> Store -> EkgAPI AsServer
+ekgServer assetsDir store = EkgAPI
+  { ekgAPI = (getAll :<|> getOne) :<|> serveDirectoryFileServer assetsDir }
+
+  where getAll = J.Sample <$> liftIO (sampleAll store)
+        getOne segments = do
+          let metric = T.intercalate "." segments
+          metrics <- liftIO (sampleAll store)
+          maybe (liftIO (T.putStrLn "not found boohoo") >> throwError err404) (return . J.Value) (HM.lookup metric metrics)
+
+
+newEkgStore :: HasEndpoint api => Proxy api -> IO (Store, Middleware)
+newEkgStore api = do
+  s <- newStore
+  registerGcMetrics s
+  registerCounter "ekg.server_timestamp_ms" getTimeMs s -- used by UI
+  mid <- monitorEndpoints api s
+  pure (s, mid)
+
+  where getTimeMs = (round . (* 1000)) `fmap` getPOSIXTime
+
+instance HasEndpoint api => HasEndpoint (Auth xs a :> api) where
+    getEndpoint        _ = getEndpoint        (Proxy :: Proxy api)
+    enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy api)
+
+instance HasEndpoint (ToServant api AsApi) => HasEndpoint (NamedRoutes api) where
+    getEndpoint        _ = getEndpoint        (Proxy @(ToServant api AsApi))
+    enumerateEndpoints _ = enumerateEndpoints (Proxy @(ToServant api AsApi))

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

+
+module Gargantext.API.Server.Named.Viz (
+  graphAPI
+  ) where
+
+import Gargantext.API.Admin.Auth (withNamedAccess)
+import Gargantext.API.Admin.Auth.Types
+import Gargantext.API.Admin.EnvTypes (Env)
+import Gargantext.API.Errors.Types ( BackendInternalError )
+import Gargantext.API.Prelude (GargM)
+import Gargantext.API.Routes.Named.Viz qualified as Named
+import Gargantext.Core.Viz.Graph.API
+import Gargantext.Core.Viz.Graph.GEXF ()
+ -- (cooc2graph)
+import Gargantext.Database.Admin.Types.Node
+import Gargantext.Prelude
+import Servant.Server.Generic (AsServerT)
+
+
+graphAPI :: AuthenticatedUser -> UserId -> NodeId -> Named.GraphAPI (AsServerT (GargM Env BackendInternalError))
+graphAPI authenticatedUser userId n = withNamedAccess authenticatedUser (PathNode n) $ Named.GraphAPI
+  { getGraphEp       = getGraph n
+  , getGraphAsyncEp  = graphAsync n
+  , cloneGraphEp     = graphClone userId n
+  , gexfEp           = getGraphGexf      n
+  , graphVersionsAPI = graphVersionsAPI  userId n
+  }
+
+
+graphVersionsAPI :: UserId -> NodeId -> Named.GraphVersionsAPI (AsServerT (GargM Env BackendInternalError))
+graphVersionsAPI u n = Named.GraphVersionsAPI
+  { getGraphVersionsEp      = graphVersions u n
+  , recomputeGraphVersionEp = recomputeVersions n
+  }

src/Gargantext/Core/Viz/Graph/Types.hs

@@ -271,3 +271,13 @@ instance Arbitrary Strength where
   arbitrary = elements $ [Strong, Weak]
 instance Arbitrary Graph where
   arbitrary = elements $ [defaultGraph]
+
+data GraphVersions =
+  GraphVersions { gv_graph :: Maybe Int
+                , gv_repo :: Int
+                }
+   deriving (Show, Generic)
+
+instance FromJSON GraphVersions
+instance ToJSON GraphVersions
+instance ToSchema GraphVersions