Named server handlers

This big commit ties the knot with the named _routes_ by providing
concrete server (i.e. handlers) implementations.

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
@@ -139,11 +140,13 @@ library
       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 +160,7 @@ library
       Gargantext.API.Routes.Named.Tree
       Gargantext.API.Routes.Named.Viz
       Gargantext.API.Routes.Types
+      Gargantext.API.Viz.Types
       Gargantext.Core
       Gargantext.Core.Mail.Types
       Gargantext.Core.Methods.Similarities
@@ -288,6 +292,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
@@ -303,11 +308,19 @@ library
       Gargantext.API.Node.FrameCalcUpload
       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

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,14 +27,17 @@ 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
+  , withNamedAccess
   , ForgotPasswordAPI
   , ForgotPasswordAsyncParams
   , ForgotPasswordAsyncAPI
@@ -42,8 +45,6 @@ module Gargantext.API.Admin.Auth
   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)
@@ -53,7 +54,7 @@ import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types
 import Gargantext.API.Auth.PolicyCheck
-import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, GargServer, _ServerError, GargM)
+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(..))
@@ -73,6 +74,9 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant
 import Servant.Auth.Server
 import Gargantext.API.Errors
+import qualified Gargantext.API.Routes.Named as Named
+import Servant.Server.Generic
+import Servant.API.Generic ()
 
 ---------------------------------------------------
 
@@ -163,10 +167,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 +196,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,15 +232,6 @@ 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
@@ -219,9 +240,12 @@ type ForgotPasswordAPI = Summary "Forgot password POST API"
                            :> 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
@@ -313,8 +337,8 @@ generateForgotPasswordUUID = do
 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 $
   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/Context.hs

@@ -23,12 +23,14 @@ 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
@@ -36,15 +38,15 @@ type ContextAPI a = Get '[JSON] (Node a)
 
 ------------------------------------------------------------------------
 -- TODO NodeAPI -> ContextAPI
-contextAPI :: forall proxy a.
-       ( JSONB a
+contextAPI :: ( IsGargServer env err m
+              , JSONB a
               , FromJSON a
-       , ToJSON a
-       ) => proxy 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'
+           -> 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,21 @@ 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 :: ServerT MembersAPI (GargM Env BackendInternalError)
-members = getMembers
+members :: IsGargServer err env m => Named.MembersAPI (AsServerT m)
+members = Named.MembersAPI 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,6 +44,7 @@ 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
@@ -61,10 +63,12 @@ type ScatterAPI = Summary "SepGen IncExc metrics"
                           :> 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
@@ -156,10 +160,12 @@ type ChartApi = Summary " Chart API"
                :> 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 +249,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
@@ -332,10 +340,13 @@ type TreeApi = Summary " Tree API"
               :> QueryParamR "ngramsType" TabType
               :> QueryParamR "listType"   ListType
               :> Get '[JSON] Text
-treeApi :: NodeId -> GargServer TreeApi
-treeApi id' = getTree id'
-         :<|> updateTree id'
-         :<|> getTreeHash id'
+
+treeApi :: IsGargServer err env m => NodeId -> Named.TreeAPI (AsServerT m)
+treeApi id' = Named.TreeAPI
+  { treeChartEp = getTree id'
+  , treeChartUpdateEp = updateTree id'
+  , treeHashEp = getTreeHash id'
+  }
 
 getTree :: HasNodeStory env err m
         => CorpusId

src/Gargantext/API/Ngrams.hs

@@ -37,8 +37,6 @@ module Gargantext.API.Ngrams
   , getTableNgramsCorpus
   , setListNgrams
   --, rmListNgrams TODO fix before exporting
-  , apiNgramsTableCorpus
-  , apiNgramsTableDoc
 
   , NgramsTablePatch
   , NgramsTableMap
@@ -96,33 +94,23 @@ import Data.Set qualified as Set
 import Data.Text (isInfixOf, toLower, unpack)
 import Data.Text.Lazy.IO as DTL ( writeFile )
 import Formatting (hprint, int, (%))
-import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
-import Gargantext.API.Admin.Types (HasSettings)
-import Gargantext.API.Errors.Types ( BackendInternalError )
-import Gargantext.API.Metrics qualified as Metrics
 import Gargantext.API.Ngrams.Tools (getNodeStory)
 import Gargantext.API.Ngrams.Types
-import Gargantext.API.Prelude ( GargM )
 import Gargantext.Core.NodeStory (ArchiveList, HasNodeStory, HasNodeArchiveStoryImmediateSaver(..), HasNodeStoryImmediateSaver(..), NgramsStatePatch', a_history, a_state, a_version, currentVersion)
 import Gargantext.Core.Text.Ngrams (Ngrams, NgramsType)
-import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, TODO, assertValid, HasValidationError, ContextId)
+import Gargantext.Core.Types (ListType(..), NodeId, ListId, TODO, assertValid, HasValidationError, ContextId)
 import Gargantext.Core.Types.Query (Limit(..), Offset(..), MinSize(..), MaxSize(..))
 import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFast)
-import Gargantext.Database.Admin.Config (userMaster)
-import Gargantext.Database.Admin.Types.Node (NodeType(..))
-import Gargantext.Database.Query.Table.Ngrams ( text2ngrams, insertNgrams, selectNgramsByDoc )
-import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Query.Table.Ngrams ( text2ngrams, insertNgrams )
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
-import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
-import Gargantext.Database.Schema.Node (node_id, node_parent_id, node_user_id)
 import Gargantext.Prelude hiding (log, to, toLower, (%), isInfixOf)
 import Gargantext.Prelude.Clock (hasTime, getTime)
-import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
-import Gargantext.Utils.Jobs.Monad (markFailedNoErr)
 import Servant hiding (Patch)
 import Text.Collate qualified as Unicode
 
+
+
 {-
 -- TODO sequences of modifications (Patchs)
 type NgramsIdPatch = Patch NgramsId NgramsPatch
@@ -409,83 +397,6 @@ tableNgramsPut tabType listId (Versioned p_version p_table)
 
 
 
-tableNgramsPostChartsAsync :: ( HasNodeStory env err m
-                              , HasSettings env
-                              , MonadJobStatus m )
-                            => UpdateTableNgramsCharts
-                            -> JobHandle m
-                            -> m ()
-tableNgramsPostChartsAsync utn jobHandle = do
-      let tabType = utn ^. utn_tab_type
-      let listId = utn ^. utn_list_id
-
-      node <- getNode listId
-      let _nId = node ^. node_id
-          _uId = node ^. node_user_id
-          mCId = node ^. node_parent_id
-
-      -- printDebug "[tableNgramsPostChartsAsync] tabType" tabType
-      -- printDebug "[tableNgramsPostChartsAsync] listId" listId
-
-      case mCId of
-        Nothing -> do
-          -- printDebug "[tableNgramsPostChartsAsync] can't update charts, no parent, nId" nId
-          markStarted 1 jobHandle
-          markFailedNoErr jobHandle
-        Just cId -> do
-          case tabType of
-            Authors -> do
-              -- printDebug "[tableNgramsPostChartsAsync] Authors, updating Pie, cId" cId
-              markStarted 1 jobHandle
-              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
-              markComplete jobHandle
-            Institutes -> do
-              -- printDebug "[tableNgramsPostChartsAsync] Institutes, updating Tree, cId" cId
-              -- printDebug "[tableNgramsPostChartsAsync] updating tree StopTerm, cId" cId
-              markStarted 3 jobHandle
-              _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
-              -- printDebug "[tableNgramsPostChartsAsync] updating tree CandidateTerm, cId" cId
-              markProgress 1 jobHandle
-              _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
-              -- printDebug "[tableNgramsPostChartsAsync] updating tree MapTerm, cId" cId
-              markProgress 1 jobHandle
-              _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
-              markComplete jobHandle
-            Sources -> do
-              -- printDebug "[tableNgramsPostChartsAsync] Sources, updating chart, cId" cId
-              markStarted 1 jobHandle
-              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
-              markComplete jobHandle
-            Terms -> do
-              -- printDebug "[tableNgramsPostChartsAsync] Terms, updating Metrics (Histo), cId" cId
-              markStarted 6 jobHandle
-{-
-              _ <- Metrics.updateChart cId listId tabType Nothing
-              logRefSuccess
-              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
-              logRefSuccess
-              _ <- Metrics.updateScatter cId (Just listId) tabType Nothing
-              logRefSuccess
-              _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
-              logRefSuccess
-              _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
-              logRefSuccess
-              _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
--}
-              markComplete jobHandle
-            _otherTabType -> do
-              -- printDebug "[tableNgramsPostChartsAsync] no update for tabType = " tabType
-              markStarted 1 jobHandle
-              markFailedNoErr jobHandle
-
-  {-
-  { _ne_list        :: ListType
-  If we merge the parents/children we can potentially create cycles!
-  , _ne_parent      :: Maybe NgramsTerm
-  , _ne_children    :: MSet NgramsTerm
-  }
-  -}
-
 getNgramsTableMap :: HasNodeStory env err m
                   => NodeId
                   -> NgramsType
@@ -671,19 +582,6 @@ setNgramsTableScores nId listId ngramsType table = do
 
 
 
-scoresRecomputeTableNgrams :: forall env err m.
-                              ( HasNodeStory env err m, HasNodeError err )
-                           => NodeId -> TabType -> ListId -> m Int
-scoresRecomputeTableNgrams nId tabType listId = do
-  tableMap <- getNgramsTableMap listId ngramsType
-  _ <- tableMap & v_data %%~ (setNgramsTableScores nId listId ngramsType)
-                           . Map.mapWithKey ngramsElementFromRepo
-
-  pure $ 1
-  where
-    ngramsType = ngramsTypeFromTabType tabType
-
-
 -- APIs
 
 -- TODO: find a better place for the code above, All APIs stay here
@@ -762,68 +660,12 @@ getTableNgramsCorpus nId tabType listId limit_ offset listType minSize maxSize o
 
 
 
-getTableNgramsVersion :: ( HasNodeStory env err m
-                         , HasNodeError err )
-                      => NodeId
-                      -> TabType
-                      -> ListId
-                      -> m Version
-getTableNgramsVersion _nId _tabType listId = currentVersion listId
-
-
-
   -- TODO: limit?
   -- Versioned { _v_version = v } <- getTableNgramsCorpus nId tabType listId 100000 Nothing Nothing Nothing Nothing Nothing Nothing
   -- This line above looks like a waste of computation to finally get only the version.
   -- See the comment about listNgramsChangedSince.
 
 
--- | Text search is deactivated for now for ngrams by doc only
-getTableNgramsDoc :: ( HasNodeStory env err m
-                     , HasNodeError err )
-                  => DocId -> TabType
-                  -> ListId -> Limit -> Maybe Offset
-                  -> Maybe ListType
-                  -> Maybe MinSize -> Maybe MaxSize
-                  -> Maybe OrderBy
-                  -> Maybe Text -- full text search
-                  -> m (VersionedWithCount NgramsTable)
-getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orderBy _mt = do
-  ns <- selectNodesWithUsername NodeList userMaster
-  let ngramsType = ngramsTypeFromTabType tabType
-  ngs <- selectNgramsByDoc (ns <> [listId]) dId ngramsType
-  let searchQueryFn (NgramsTerm nt) = Set.member nt (Set.fromList ngs)
-      searchQuery = NgramsSearchQuery {
-                    _nsq_limit       = limit_
-                  , _nsq_offset      = offset
-                  , _nsq_listType    = listType
-                  , _nsq_minSize     = minSize
-                  , _nsq_maxSize     = maxSize
-                  , _nsq_orderBy     = orderBy
-                  , _nsq_searchQuery = searchQueryFn
-                  }
-  getTableNgrams dId listId tabType searchQuery
-
-
-apiNgramsTableCorpus :: NodeId -> ServerT TableNgramsApi (GargM Env BackendInternalError)
-apiNgramsTableCorpus cId =  getTableNgramsCorpus       cId
-                       :<|> tableNgramsPut
-                       :<|> scoresRecomputeTableNgrams cId
-                       :<|> getTableNgramsVersion      cId
-                       :<|> apiNgramsAsync             cId
-
-apiNgramsTableDoc :: DocId -> ServerT TableNgramsApi (GargM Env BackendInternalError)
-apiNgramsTableDoc dId =  getTableNgramsDoc          dId
-                    :<|> tableNgramsPut
-                    :<|> scoresRecomputeTableNgrams dId
-                    :<|> getTableNgramsVersion      dId
-                    :<|> apiNgramsAsync             dId
-
-apiNgramsAsync :: NodeId -> ServerT TableNgramsAsyncApi (GargM Env BackendInternalError)
-apiNgramsAsync _dId =
-  serveJobsAPI TableNgramsJob $ \jHandle i -> withTracer (printDebug "tableNgramsPostChartsAsync") jHandle $
-    \jHandle' -> tableNgramsPostChartsAsync i jHandle'
-
 -- Did the given list of ngrams changed since the given version?
 -- The returned value is versioned boolean value, meaning that one always retrieve the
 -- latest version.

src/Gargantext/API/Ngrams/List.hs

@@ -35,6 +35,7 @@ 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.Routes.Named.List qualified as Named
 import Gargantext.API.Types (HTML)
 import Gargantext.Core.NodeStory.Types ( HasNodeStory )
 import Gargantext.Core.Text.Ngrams (Ngrams, NgramsType(NgramsTerms))
@@ -51,6 +52,8 @@ 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"
@@ -62,10 +65,13 @@ type GETAPI = Summary "Get List"
                    :> 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
@@ -80,8 +86,8 @@ type JSONAPI = Summary "Update List"
           :> "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 +128,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 ->
   serveJobsAPI UpdateNgramsListJobJSON $ \jHandle f ->
     postAsyncJSON lId (_wjf_data f) jHandle
 
@@ -169,12 +175,12 @@ type CSVAPI = Summary "Update List (legacy v3 CSV)"
             :> "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 ->
   serveJobsAPI UpdateNgramsListJobCSV $ \jHandle f -> do
     case ngramsListFromCSVData (_wtf_data f) of
       Left err         -> serverError $ err500 { errReasonPhrase = err }

src/Gargantext/API/Node.hs

@@ -28,33 +28,42 @@ Node API
 module Gargantext.API.Node
   where
 
-import Data.Swagger (ToSchema)
-import Gargantext.API.Admin.Auth (withAccess, withPolicy)
+import Gargantext.API.Admin.Auth (withNamedAccess, withNamedPolicyT)
 import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..), auth_node_id)
 import Gargantext.API.Admin.EnvTypes (Env)
-import Gargantext.API.Auth.PolicyCheck ( PolicyChecked, nodeChecks )
+import Gargantext.API.Auth.PolicyCheck ( PolicyChecked, nodeChecks, AccessPolicyManager )
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Metrics
-import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
+import Gargantext.API.Ngrams (TableNgramsApi)
 import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Node.DocumentUpload qualified as DocumentUpload
 import Gargantext.API.Node.DocumentsFromWriteNodes qualified as DFWN
 import Gargantext.API.Node.File ( FileAsyncApi, FileApi, fileApi, fileAsyncApi )
 import Gargantext.API.Node.FrameCalcUpload qualified as FrameCalcUpload
-import Gargantext.API.Node.New ( PostNodeAsync, PostNode, postNode, postNodeAsyncAPI )
+import Gargantext.API.Node.New ( PostNodeAsync, postNode, postNodeAsyncAPI )
 import Gargantext.API.Node.Share qualified as Share
+import Gargantext.API.Node.Types
 import Gargantext.API.Node.Update qualified as Update
-import Gargantext.API.Prelude ( GargM, GargServer )
+import Gargantext.API.Prelude ( GargM, GargServer, IsGargServer )
+import Gargantext.API.Routes.Named.Document qualified as Named
+import Gargantext.API.Routes.Named.File qualified as Named
+import Gargantext.API.Routes.Named.FrameCalc qualified as Named
+import Gargantext.API.Routes.Named.Node (PostNode)
+import Gargantext.API.Routes.Named.Node qualified as Named
+import Gargantext.API.Routes.Named.Private qualified as Named
+import Gargantext.API.Routes.Named.Share qualified as Named
 import Gargantext.API.Search qualified as Search
+import Gargantext.API.Search.Types qualified as Search
+import Gargantext.API.Server.Named.Ngrams (apiNgramsTableCorpus)
 import Gargantext.API.Table ( TableApi, tableApi, getPair )
 import Gargantext.Core.Types (NodeTableResult)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main (Tree, NodeTree)
 import Gargantext.Core.Types.Query (Limit, Offset)
-import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Core.Viz.Phylo.API (PhyloAPI, phyloAPI)
 import Gargantext.Database.Action.Delete qualified as Action (deleteNode)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
+import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny, HyperdataCorpus, HyperdataAnnuaire)
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( HyperdataC )
 import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
 import Gargantext.Database.Admin.Types.Node
@@ -71,8 +80,8 @@ import Gargantext.Database.Query.Table.NodeNode
 import Gargantext.Database.Query.Tree (tree, tree_flat, TreeMode(..))
 import Gargantext.Prelude
 import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import Servant.Server.Generic (AsServerT)
+import Gargantext.API.Routes.Named.Tree qualified as Named
 
 
 -- | Admin NodesAPI
@@ -82,8 +91,8 @@ type NodesAPI  = Delete '[JSON] Int
 -- | Delete Nodes
 -- Be careful: really delete nodes
 -- Access by admin only
-nodesAPI :: [NodeId] -> GargServer NodesAPI
-nodesAPI = deleteNodes
+nodesAPI :: IsGargServer err env m => [NodeId] -> Named.NodesAPI (AsServerT m)
+nodesAPI nodes = Named.NodesAPI { deleteNodeEp = deleteNodes nodes }
 
 ------------------------------------------------------------------------
 -- | TODO-ACCESS: access by admin only.
@@ -97,9 +106,11 @@ type Roots =  Get    '[JSON] [Node HyperdataUser]
          :<|> Put    '[JSON] Int -- TODO
 
 -- | TODO: access by admin only
-roots :: GargServer Roots
-roots = getNodesWithParentId Nothing
-    :<|> pure (panicTrace "not implemented yet") -- TODO use patch map to update what we need
+roots :: IsGargServer err env m => Named.Roots (AsServerT m)
+roots = Named.Roots
+  { getRootsEp = getNodesWithParentId Nothing
+  , putRootsEp = pure (panicTrace "not implemented yet") -- TODO use patch map to update what we need
+  }
 
 -------------------------------------------------------------------
 -- | Node API Types management
@@ -176,20 +187,17 @@ type ChildrenApi a = Summary " Summary children"
 ------------------------------------------------------------------------
 type NodeNodeAPI a = Get '[JSON] (Node a)
 
-nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a)
+nodeNodeAPI :: forall proxy a env err m. (JSONB a, ToJSON a, IsGargServer env err m)
             => proxy a
             -> AuthenticatedUser
             -> CorpusId
             -> NodeId
-            -> GargServer (NodeNodeAPI a)
-nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathNodeNode cId nId) nodeNodeAPI'
+            -> Named.NodeNodeAPI a (AsServerT m)
+nodeNodeAPI p uId cId nId =
+  withNamedAccess uId (PathNodeNode cId nId) nodeNodeAPI'
   where
-    nodeNodeAPI' :: GargServer (NodeNodeAPI a)
-    nodeNodeAPI' = getNodeWith nId p
-
-------------------------------------------------------------------------
-data RenameNode = RenameNode { r_name :: Text }
-  deriving (Generic)
+    nodeNodeAPI' :: Named.NodeNodeAPI a (AsServerT m)
+    nodeNodeAPI' = Named.NodeNodeAPI $ getNodeWith nId p
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
@@ -197,16 +205,6 @@ type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral,
             :> ReqBody '[JSON] NodesToCategory
             :> Put     '[JSON] [Int]
 
-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
-
 catApi :: CorpusId -> GargServer CatApi
 catApi cId cs' = do
   ret <- nodeContextsCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
@@ -219,16 +217,6 @@ type ScoreApi =  Summary " To Score NodeNodes"
             :> ReqBody '[JSON] NodesToScore
             :> Put     '[JSON] [Int]
 
-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
-
 scoreApi :: CorpusId -> GargServer ScoreApi
 scoreApi = putScore
   where
@@ -249,8 +237,8 @@ type PairingApi = Summary " Pairing API"
 ----------
 type Pairs    = Summary "List of Pairs"
               :> Get '[JSON] [AnnuaireId]
-pairs :: CorpusId -> GargServer Pairs
-pairs cId = do
+pairs :: IsGargServer err env m => CorpusId -> Named.Pairs (AsServerT m)
+pairs cId = Named.Pairs $ do
   ns <- getNodeNode cId
   pure $ map _nn_node2_id ns
 
@@ -259,8 +247,8 @@ type PairWith = Summary "Pair a Corpus with an Annuaire"
               :> QueryParam "list_id"     ListId
               :> Post '[JSON] [Int]
 
-pairWith :: CorpusId -> GargServer PairWith
-pairWith cId aId lId = do
+pairWith :: IsGargServer err env m => CorpusId -> Named.PairWith (AsServerT m)
+pairWith cId = Named.PairWith $ \ aId lId -> do
   r <- pairing cId aId lId
   _ <- insertNodeNode [ NodeNode { _nn_node1_id = cId
                                  , _nn_node2_id = aId
@@ -276,16 +264,28 @@ type TreeAPI   = QueryParams "type" NodeType
                       :> QueryParams "type" NodeType
                       :> Get '[JSON] (Tree NodeTree)
 
-treeAPI :: NodeId -> GargServer TreeAPI
-treeAPI id = tree TreeAdvanced id
-        :<|> tree TreeFirstLevel id
+treeAPI :: IsGargServer env BackendInternalError m
+        => AuthenticatedUser
+        -> NodeId
+        -> AccessPolicyManager
+        -> Named.NodeTreeAPI (AsServerT m)
+treeAPI authenticatedUser nodeId mgr =
+  withNamedPolicyT authenticatedUser (nodeChecks nodeId) (Named.NodeTreeAPI
+    { nodeTreeEp   = tree TreeAdvanced nodeId
+    , firstLevelEp = tree TreeFirstLevel nodeId
+    }) mgr
 
 type TreeFlatAPI = QueryParams "type" NodeType
                     :> QueryParam "query" Text
                     :> Get '[JSON] [NodeTree]
 
-treeFlatAPI :: NodeId -> GargServer TreeFlatAPI
-treeFlatAPI = tree_flat
+treeFlatAPI :: IsGargServer env err m
+            => AuthenticatedUser
+            -> RootId
+            -> Named.TreeFlatAPI (AsServerT m)
+treeFlatAPI authenticatedUser rootId =
+  withNamedAccess authenticatedUser (PathNode rootId) $
+    Named.TreeFlatAPI { getNodesEp = tree_flat rootId }
 
 ------------------------------------------------------------------------
 -- | TODO Check if the name is less than 255 char
@@ -310,65 +310,67 @@ moveNode :: User
 moveNode _u n p = update (Move n p)
 -------------------------------------------------------------
 
+annuaireNodeAPI :: AuthenticatedUser
+                -> Named.NodeAPIEndpoint HyperdataAnnuaire (AsServerT (GargM Env BackendInternalError))
+annuaireNodeAPI authenticatedUser = Named.NodeAPIEndpoint $ \targetNode ->
+  withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
+  where
+    concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataAnnuaire) authenticatedUser
 
-$(deriveJSON (unPrefix "r_"       ) ''RenameNode )
-instance ToSchema  RenameNode
-instance Arbitrary RenameNode where
-  arbitrary = elements [RenameNode "test"]
+corpusNodeAPI :: AuthenticatedUser
+              -> Named.NodeAPIEndpoint HyperdataCorpus (AsServerT (GargM Env BackendInternalError))
+corpusNodeAPI authenticatedUser = Named.NodeAPIEndpoint $ \targetNode ->
+  withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
+  where
+    concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataCorpus) authenticatedUser
 
 ------------------------------------------------------------------------
--- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
-nodeAPI :: forall proxy a.
-       ( HyperdataC a, Show a, MimeUnrender JSON a
-       ) => proxy a
+nodeAPI :: AuthenticatedUser
+        -> Named.NodeAPIEndpoint HyperdataAny (AsServerT (GargM Env BackendInternalError))
+nodeAPI authenticatedUser = Named.NodeAPIEndpoint $ \targetNode ->
+  withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
+  where
+    concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataAny) authenticatedUser
+
+-- | The /actual/ (generic) node API, instantiated depending on the concrete type of node.
+genericNodeAPI' :: forall a proxy. ( HyperdataC a, Show a, MimeUnrender JSON a, Named.IsGenericNodeRoute a )
+                => proxy a
                 -> AuthenticatedUser
                 -> NodeId
-         -> ServerT (NodeAPI a) (GargM Env BackendInternalError)
-nodeAPI p authenticatedUser targetNode =
-  withAccess (Proxy :: Proxy (NodeAPI a)) Proxy authenticatedUser (PathNode targetNode) nodeAPI'
+                -> Named.NodeAPI a (AsServerT (GargM Env BackendInternalError))
+genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
+  { nodeNodeAPI        = withNamedPolicyT authenticatedUser (nodeChecks targetNode) $
+                           Named.NodeNodeAPI $ getNodeWith targetNode (Proxy :: Proxy a)
+  , renameAPI          = Named.RenameAPI   $ rename targetNode
+  , postNodeAPI        = Named.PostNodeAPI $ postNode authenticatedUser targetNode
+  , postNodeAsyncAPI   = postNodeAsyncAPI authenticatedUser targetNode
+  , frameCalcUploadAPI = Named.FrameCalcAPI $ FrameCalcUpload.api authenticatedUser targetNode
+  , putEp              = putNode targetNode
+  , updateAPI          = Named.UpdateAPI $ Update.api targetNode
+  , deleteEp           = Action.deleteNode userRootId targetNode
+  , childrenAPI        = Named.ChildrenAPI $ getChildren targetNode (Proxy :: Proxy a)
+  , tableAPI           = tableApi targetNode
+  , tableNgramsAPI     = apiNgramsTableCorpus targetNode
+  , catAPI             = Named.CatAPI $ catApi targetNode
+  , scoreAPI           = Named.ScoreAPI $ scoreApi targetNode
+  , searchAPI          = Search.api targetNode
+  , shareAPI           = Named.ShareNode $ Share.api userRootId targetNode
+  ---- Pairing utilities
+  , pairWithEp         = pairWith targetNode
+  , pairsEp            = pairs targetNode
+  , pairingEp          = Named.PairingAPI $ getPair targetNode
+  ---- VIZ
+  , scatterAPI         = scatterApi targetNode
+  , chartAPI           = chartApi targetNode
+  , pieAPI             = pieApi targetNode
+  , treeAPI            = treeApi targetNode
+  , phyloAPI           = phyloAPI targetNode
+  , moveAPI            = Named.MoveAPI $ moveNode userRootId targetNode
+  , unpublishEp        = Named.Unpublish $ Share.unPublish targetNode
+  , fileAPI            = Named.FileAPI $ fileApi targetNode
+  , fileAsyncAPI       = Named.FileAsyncAPI $ fileAsyncApi authenticatedUser targetNode
+  , dfwnAPI            = Named.DocumentsFromWriteNodesAPI $ DFWN.api authenticatedUser targetNode
+  , documentUploadAPI  = Named.DocumentUploadAPI $ DocumentUpload.api targetNode
+  }
   where
-
     userRootId = RootId $ authenticatedUser ^. auth_node_id
-
-    nodeAPI' :: ServerT (NodeAPI a) (GargM Env BackendInternalError)
-    nodeAPI' =  withPolicy authenticatedUser (nodeChecks targetNode) (getNodeWith targetNode p)
-           :<|> rename                                targetNode
-           :<|> postNode            authenticatedUser targetNode
-           :<|> postNodeAsyncAPI    authenticatedUser targetNode
-           :<|> FrameCalcUpload.api authenticatedUser targetNode
-           :<|> putNode                               targetNode
-           :<|> Update.api                            targetNode
-           :<|> Action.deleteNode   userRootId        targetNode
-           :<|> getChildren                           targetNode p
-
-           -- TODO gather it
-           :<|> tableApi                              targetNode
-           :<|> apiNgramsTableCorpus                  targetNode
-
-           :<|> catApi                                targetNode
-           :<|> scoreApi                              targetNode
-           :<|> Search.api                            targetNode
-           :<|> Share.api           userRootId        targetNode
-           -- Pairing Tools
-           :<|> pairWith                              targetNode
-           :<|> pairs                                 targetNode
-           :<|> getPair                               targetNode
-
-           -- VIZ
-           :<|> scatterApi                            targetNode
-           :<|> chartApi                              targetNode
-           :<|> pieApi                                targetNode
-           :<|> treeApi                               targetNode
-           :<|> phyloAPI                              targetNode
-           :<|> moveNode           userRootId         targetNode
-           -- :<|> nodeAddAPI id'
-           -- :<|> postUpload id'
-           :<|> Share.unPublish                       targetNode
-
-           :<|> fileApi                               targetNode
-           :<|> fileAsyncApi       authenticatedUser  targetNode
-
-           :<|> DFWN.api           authenticatedUser  targetNode
-           :<|> DocumentUpload.api                    targetNode
-
-

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.Types (HasSettings)
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Node ( nodeNodeAPI, 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,13 +38,11 @@ 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))
+import Servant.Server.Generic (AsServerT)
 
 ------------------------------------------------------------------------
 type API = "contact" :> Summary "Contact endpoint"
@@ -53,23 +51,17 @@ type API = "contact" :> Summary "Contact endpoint"
             :> NodeNodeAPI HyperdataContact
 
 
-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)
+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
+  }
 
 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)
 
 ----------------------------------------------------------------------
-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 $
   serveJobsAPI AddContactJob $ \jHandle p ->
     addContact u nId p jHandle
 
@@ -88,16 +80,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/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 (GargNoServer, IsGargServer)
 import Gargantext.Core.NodeStory.Types ( NodeListStory )
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
 import Gargantext.Core.Types.Main ( ListType(MapTerm) )
@@ -43,6 +43,8 @@ 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)
+import Servant.Server.Generic (AsServerT)
+import qualified Gargantext.API.Routes.Named.Corpus as Named
 
 --------------------------------------------------
 type API = Summary "Corpus Export"
@@ -53,12 +55,17 @@ type API = Summary "Corpus Export"
 
 --------------------------------------------------
 -- | 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'
 
+  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'
 

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
+documentExportAPI :: IsGargServer env err m
+                  => NodeId
                   -- ^ The ID of the target user
                   -> DocId
-    -> GargServer API
-api userNodeId dId = getDocumentsJSON userNodeId dId
-                :<|> getDocumentsJSONZip userNodeId dId
-                :<|> getDocumentsCSV userNodeId dId
+                  -> 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/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.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
@@ -36,23 +36,7 @@ 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
@@ -76,8 +60,8 @@ postNodeAsyncAPI
   -- ^ 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 $
   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

src/Gargantext/API/Node/ShareURL.hs

@@ -11,19 +11,21 @@ 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
 
-api :: ServerT API (GargM Env BackendInternalError)
-api = getUrl
+shareURL :: IsGargServer env err m => Named.ShareURL (AsServerT m)
+shareURL = Named.ShareURL 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/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.hs

@@ -23,30 +23,28 @@ module Gargantext.API.Routes
 
 import Control.Lens (view)
 import Data.Validity
-import Gargantext.API.Admin.Auth (ForgotPasswordAPI, ForgotPasswordAsyncAPI, withAccess, withPolicyT)
-import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))
+import Gargantext.API.Admin.Auth (ForgotPasswordAPI, ForgotPasswordAsyncAPI)
+import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..))
 import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
 import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.Context
-import Gargantext.API.Count  (CountAPI, count, Query)
+import Gargantext.API.Count.Types (Query, Counts)
 import Gargantext.API.Errors.Types
 import Gargantext.API.GraphQL qualified as GraphQL
-import Gargantext.API.Members (MembersAPI, members)
-import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableDoc)
+import Gargantext.API.Members (MembersAPI)
+import Gargantext.API.Ngrams (TableNgramsApi)
 import Gargantext.API.Ngrams.List qualified as List
 import Gargantext.API.Node
 import Gargantext.API.Node.Contact qualified as Contact
 import Gargantext.API.Node.Corpus.Annuaire qualified as Annuaire
 import Gargantext.API.Node.Corpus.Export qualified as CorpusExport
 import Gargantext.API.Node.Corpus.New qualified as New
-import Gargantext.API.Node.Document.Export qualified as DocumentExport
 import Gargantext.API.Node.Document.Export.Types qualified as DocumentExport
-import Gargantext.API.Node.Phylo.Export qualified as PhyloExport
 import Gargantext.API.Node.Phylo.Export.Types qualified as PhyloExport
 import Gargantext.API.Node.ShareURL qualified as ShareURL
 import Gargantext.API.Prelude
-import Gargantext.API.Public qualified as Public
+import Gargantext.API.Routes.Named.Corpus qualified as Named
 import Gargantext.API.Routes.Types
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Viz.Graph.API
@@ -59,8 +57,10 @@ import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Servant
 import Servant.Auth as SA
 import Servant.Auth.Swagger ()
+import Servant.Server.Generic (AsServerT)
 import Servant.Swagger
 import Servant.Swagger.UI
+import Gargantext.API.Routes.Named.Annuaire qualified as Named
 
 type GargAPI = MkGargAPI (GargAPIVersion GargAPI')
 
@@ -92,7 +92,7 @@ type GargAPI' =
                    -- TODO-ACCESS here we want to request a particular header for
            -- auth and capabilities.
           :<|> GargPrivateAPI
-          :<|> "public"      :> Public.API
+          -- :<|> "public"      :> Public.API
 
 
 type MkProtectedAPI private = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> private
@@ -166,7 +166,7 @@ type GargPrivateAPI' =
             -- TODO-SECURITY
            :<|> "count"    :> Summary "Count endpoint"
                            :> ReqBody '[JSON] Query
-                           :> CountAPI
+                           :> Post '[JSON] Counts
 
            -- Corpus endpoint --> TODO rename s/search/filter/g
            -- :<|> "search"   :> Capture "corpus" NodeId
@@ -239,65 +239,6 @@ type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
        -- :<|> "auth"     :> Capture "node_id" Int  :> NodeAPI
 ---------------------------------------------------------------------
 
----------------------------------------------------------------------
--- | Server declarations
-
--- TODO-SECURITY admin only: withAdmin
--- Question: How do we mark admins?
-serverGargAdminAPI :: GargServer GargAdminAPI
-serverGargAdminAPI =  roots
-                 :<|> nodesAPI
-
-
-serverPrivateGargAPI'
-  :: AuthenticatedUser -> ServerT GargPrivateAPI' (GargM Env BackendInternalError)
-serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
-       =  serverGargAdminAPI
-     :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      authenticatedUser
-     :<|> contextAPI  (Proxy :: Proxy HyperdataAny)      authenticatedUser
-     :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   authenticatedUser
-     :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      authenticatedUser
-     :<|> CorpusExport.getCorpus   -- uid
- --    :<|> nodeAPI     (Proxy :: Proxy HyperdataContact)  uid
-     :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) authenticatedUser
-     :<|> Contact.api authenticatedUser
-
-     :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy authenticatedUser
-          <$> PathNode <*> apiNgramsTableDoc
-
-     :<|> DocumentExport.api userNodeId
-
-     :<|> PhyloExport.api userNodeId
-
-     :<|> count -- TODO: undefined
-
-     -- :<|> withAccess (Proxy :: Proxy (Search.API Search.SearchResult)) Proxy uid
-     --     <$> PathNode <*> Search.api -- TODO: move elsewhere
-
-     :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy authenticatedUser
-          <$> PathNode <*> graphAPI userId -- TODO: mock
-
-     :<|> (\nodeId -> withPolicyT (Proxy @TreeAPI) Proxy authenticatedUser (nodeChecks nodeId) (treeAPI nodeId))
-
-     :<|> withAccess (Proxy :: Proxy TreeFlatAPI)    Proxy authenticatedUser
-          <$> PathNode <*> treeFlatAPI
-
-     :<|> members
-     -- TODO access
-     :<|> addCorpusWithForm  (RootId userNodeId)
-    -- :<|> addCorpusWithFile  (RootId (NodeId uid))
-     :<|> addCorpusWithQuery (RootId userNodeId)
-
-     -- :<|> addAnnuaireWithForm
-     -- :<|> New.api  uid -- TODO-SECURITY
-     -- :<|> New.info uid -- TODO-SECURITY
-     :<|> List.getApi
-     :<|> List.jsonApi
-     :<|> List.csvApi
-     :<|> ShareURL.api
---     :<|> waitAPI
-
-
 ----------------------------------------------------------------------
 -- For Tests
 type WaitAPI = Get '[JSON] Text
@@ -310,8 +251,8 @@ waitAPI n = do
   pure $ "Waited: " <> show n
 ----------------------------------------
 
-addCorpusWithQuery :: User -> ServerT New.AddWithQuery (GargM Env BackendInternalError)
-addCorpusWithQuery user cid =
+addCorpusWithQuery :: User -> Named.AddWithQuery (AsServerT (GargM Env BackendInternalError))
+addCorpusWithQuery user = Named.AddWithQuery $ \cid ->
   serveJobsAPI AddCorpusQueryJob $ \jHandle q -> do
     limit <- view $ hasConfig . gc_max_docs_scrapers
     New.addToCorpusWithQuery user cid q (Just $ fromIntegral limit) jHandle
@@ -320,8 +261,8 @@ addCorpusWithQuery user cid =
         liftBase $ log x
       -}
 
-addCorpusWithForm :: User -> ServerT New.AddWithForm (GargM Env BackendInternalError)
-addCorpusWithForm user cid =
+addCorpusWithForm :: User -> Named.AddWithForm (AsServerT (GargM Env BackendInternalError))
+addCorpusWithForm user = Named.AddWithForm $ \cid ->
   serveJobsAPI AddCorpusFormJob $ \jHandle i -> do
     -- /NOTE(adinapoli)/ Track the initial steps outside 'addToCorpusWithForm', because it's
     -- called in a few places, and the job status might be different between invocations.
@@ -333,7 +274,7 @@ addCorpusWithFile user cid =
   serveJobsAPI AddCorpusFileJob $ \jHandle i ->
     New.addToCorpusWithFile user cid i jHandle
 
-addAnnuaireWithForm :: ServerT Annuaire.AddWithForm (GargM Env BackendInternalError)
-addAnnuaireWithForm cid =
+addAnnuaireWithForm :: Named.AddAnnuaireWithForm (AsServerT (GargM Env BackendInternalError))
+addAnnuaireWithForm = Named.AddAnnuaireWithForm $ \cid ->
   serveJobsAPI AddAnnuaireFormJob $ \jHandle i ->
     Annuaire.addToAnnuaireWithForm cid i jHandle

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 {
+  mkBackendAPI :: 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
 
@@ -62,5 +101,5 @@ data ForgotPasswordAsyncAPI mode = ForgotPasswordAsyncAPI
 
 
 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"
+                          :> 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
@@ -28,11 +28,3 @@ data ContactAPI mode = ContactAPI
 newtype ContactAsyncAPI mode = ContactAsyncAPI
   { addContactAsyncEp :: mode :- 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,16 +26,15 @@ 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
+                          :> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
   } deriving Generic
 
-
 newtype AddWithQuery mode = AddWithQuery
   { addWithQueryEp :: mode :- Summary "Add with Query to corpus endpoint"
                            :> "corpus"

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,44 +6,33 @@ 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 ( Params(..) )
+import Gargantext.API.Node.DocumentUpload ( DocumentUpload(..),  )
 import Gargantext.Utils.Servant (ZIP)
-import Prelude
 import Servant
 
 newtype DocumentExportAPI mode = DocumentExportAPI
-  { documentExportAPI ::
-      mode :- Summary "Document Export"
-           :> "export"
-           :> ( "json"
+  { 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)
-              :<|> "json.zip"
+  , exportJSONZipEp :: mode :- "json.zip"
                             :> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
-              :<|> "csv"
-                :> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text) )
+  , exportCSVEp :: mode :- "csv"
+                        :> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text)
   } deriving Generic
 
 newtype DocumentsFromWriteNodesAPI mode = DocumentsFromWriteNodesAPI
@@ -59,59 +48,3 @@ newtype DocumentUploadAPI mode = DocumentUploadAPI
                              :> "async"
                              :> 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/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.Admin.Orchestrator.Types
 
-data FrameCalcAPI mode = FrameCalcAPI
+
+newtype FrameCalcAPI mode = FrameCalcAPI
   { frameCalcUploadEp :: mode :- Summary " FrameCalc upload"
                               :> "add"
                               :> "framecalc"

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,15 +22,17 @@ newtype GETAPI mode = GETAPI
   { getListEp :: mode :- Summary "Get List"
                       :> "lists"
                       :> Capture "listId" ListId
-                      :> ( "json"
+                      :> NamedRoutes ListEndpoints
+  } deriving Generic
+
+data ListEndpoints mode = ListEndpoints
+  { listJSONEp :: mode :- "json"
                        :> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
-                         :<|>  "json.zip"
+  , listJSONZipEp :: mode :- "json.zip"
                           :> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
-                         :<|> "csv"
-                           :> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap) )
+  , listCSVEp :: mode :- "csv" :> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap)
   } deriving Generic
 
-
 newtype JSONAPI mode = JSONAPI
   { updateListJSONEp :: mode :- Summary "Update List"
                              :> "lists"

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 ( 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,7 +117,7 @@ newtype PostNodeAPI mode = PostNodeAPI
 
 
 newtype ChildrenAPI a mode = ChildrenAPI
-  { summaryChildrenEp :: Summary " Summary children"
+  { summaryChildrenEp :: mode :- Summary " Summary children"
                               :> QueryParam "type"   NodeType
                               :> QueryParam "offset" Offset
                               :> QueryParam "limit"  Limit
@@ -137,7 +130,7 @@ 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
@@ -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
@@ -32,6 +37,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 +51,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 +63,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 +73,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 +83,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 +104,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 ( 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
@@ -112,30 +109,3 @@ data TableNgramsAsyncAPI mode = TableNgramsAsyncAPI
                                       :> "update"
                                       :> 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
@@ -73,50 +71,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/Search.hs

@@ -22,7 +22,9 @@ module Gargantext.API.Search
 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 (GargServer, 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
@@ -37,6 +39,7 @@ 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
@@ -49,17 +52,16 @@ type API results = Summary "Search endpoint"
                  :> 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 +74,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
+  (SearchQuery _q SearchDocWithNgrams) -> panicTrace "unimplemented"
 
------------------------------------------------------------------------
------------------------------------------------------------------------
--- | 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/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)
+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))
-     :<|> hoistServerWithContext
+     , graphqlAPI = hoistServerWithContext
                       (Proxy :: Proxy GraphQL.API)
                       (Proxy :: Proxy AuthContext)
                       (transformJSONGQL errScheme)
                       GraphQL.api
-     :<|> frontEndServer
+     , 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/Ngrams.hs

+
+module Gargantext.API.Server.Named.Ngrams (
+  -- * Server handlers
+    apiNgramsTableCorpus
+  , apiNgramsTableDoc
+  ) where
+
+import Control.Lens ((%%~))
+import Data.Map.Strict qualified as Map
+import Data.Set qualified as Set
+import Gargantext.API.Admin.Auth (withNamedAccess)
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser, PathId (..))
+import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.Types (HasSettings)
+import Gargantext.API.Errors.Types (BackendInternalError)
+import Gargantext.API.Metrics qualified as Metrics
+import Gargantext.API.Ngrams
+import Gargantext.API.Ngrams.Types
+import Gargantext.API.Prelude
+import Gargantext.API.Routes.Named.Table qualified as Named
+import Gargantext.Core.NodeStory.Types (HasNodeStory)
+import Gargantext.Core.Types hiding (Terms)
+import Gargantext.Core.Types.Query (Limit(..), Offset(..))
+import Gargantext.Database.Admin.Config (userMaster)
+import Gargantext.Database.Query.Table.Ngrams ( selectNgramsByDoc )
+import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
+import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
+import Gargantext.Database.Schema.Node (node_id, node_parent_id, node_user_id)
+import Gargantext.Prelude
+import Gargantext.Utils.Jobs (serveJobsAPI)
+import Gargantext.Utils.Jobs.Monad
+import Servant.Server.Generic (AsServerT)
+
+
+apiNgramsTableCorpus :: NodeId -> Named.TableNgramsAPI (AsServerT (GargM Env BackendInternalError))
+apiNgramsTableCorpus cId = Named.TableNgramsAPI
+  { tableNgramsGetAPI       = Named.TableNgramsApiGet $ getTableNgramsCorpus       cId
+  , tableNgramsPutAPI       = Named.TableNgramsApiPut $ tableNgramsPut
+  , recomputeScoresEp       = Named.RecomputeScoresNgramsApiGet $ scoresRecomputeTableNgrams cId
+  , tableNgramsGetVersionEp = Named.TableNgramsApiGetVersion $ getTableNgramsVersion      cId
+  , tableNgramsAsyncAPI     = apiNgramsAsync             cId
+  }
+
+
+apiNgramsTableDoc :: AuthenticatedUser
+                  -> DocId
+                  -> Named.TableNgramsAPI (AsServerT (GargM Env BackendInternalError))
+apiNgramsTableDoc uid dId = withNamedAccess uid (PathNode dId) $ Named.TableNgramsAPI
+  { tableNgramsGetAPI       = Named.TableNgramsApiGet $ getTableNgramsDoc dId
+  , tableNgramsPutAPI       = Named.TableNgramsApiPut tableNgramsPut
+  , recomputeScoresEp       = Named.RecomputeScoresNgramsApiGet $ scoresRecomputeTableNgrams dId
+  , tableNgramsGetVersionEp = Named.TableNgramsApiGetVersion $ getTableNgramsVersion dId
+  , tableNgramsAsyncAPI     = apiNgramsAsync dId
+  }
+
+
+getTableNgramsVersion :: ( HasNodeStory env err m
+                         , HasNodeError err )
+                      => NodeId
+                      -> TabType
+                      -> ListId
+                      -> m Version
+getTableNgramsVersion _nId _tabType listId = currentVersion listId
+
+
+apiNgramsAsync :: NodeId -> Named.TableNgramsAsyncAPI (AsServerT (GargM Env BackendInternalError))
+apiNgramsAsync _dId = Named.TableNgramsAsyncAPI $
+  serveJobsAPI TableNgramsJob $ \jHandle i -> withTracer (printDebug "tableNgramsPostChartsAsync") jHandle $
+    \jHandle' -> tableNgramsPostChartsAsync i jHandle'
+
+
+tableNgramsPostChartsAsync :: ( HasNodeStory env err m
+                              , HasSettings env
+                              , MonadJobStatus m )
+                            => UpdateTableNgramsCharts
+                            -> JobHandle m
+                            -> m ()
+tableNgramsPostChartsAsync utn jobHandle = do
+      let tabType = utn ^. utn_tab_type
+      let listId = utn ^. utn_list_id
+
+      node <- getNode listId
+      let _nId = node ^. node_id
+          _uId = node ^. node_user_id
+          mCId = node ^. node_parent_id
+
+      -- printDebug "[tableNgramsPostChartsAsync] tabType" tabType
+      -- printDebug "[tableNgramsPostChartsAsync] listId" listId
+
+      case mCId of
+        Nothing -> do
+          -- printDebug "[tableNgramsPostChartsAsync] can't update charts, no parent, nId" nId
+          markStarted 1 jobHandle
+          markFailedNoErr jobHandle
+        Just cId -> do
+          case tabType of
+            Authors -> do
+              -- printDebug "[tableNgramsPostChartsAsync] Authors, updating Pie, cId" cId
+              markStarted 1 jobHandle
+              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
+              markComplete jobHandle
+            Institutes -> do
+              -- printDebug "[tableNgramsPostChartsAsync] Institutes, updating Tree, cId" cId
+              -- printDebug "[tableNgramsPostChartsAsync] updating tree StopTerm, cId" cId
+              markStarted 3 jobHandle
+              _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
+              -- printDebug "[tableNgramsPostChartsAsync] updating tree CandidateTerm, cId" cId
+              markProgress 1 jobHandle
+              _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
+              -- printDebug "[tableNgramsPostChartsAsync] updating tree MapTerm, cId" cId
+              markProgress 1 jobHandle
+              _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
+              markComplete jobHandle
+            Sources -> do
+              -- printDebug "[tableNgramsPostChartsAsync] Sources, updating chart, cId" cId
+              markStarted 1 jobHandle
+              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
+              markComplete jobHandle
+            Terms -> do
+              -- printDebug "[tableNgramsPostChartsAsync] Terms, updating Metrics (Histo), cId" cId
+              markStarted 6 jobHandle
+{-
+              _ <- Metrics.updateChart cId listId tabType Nothing
+              logRefSuccess
+              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
+              logRefSuccess
+              _ <- Metrics.updateScatter cId (Just listId) tabType Nothing
+              logRefSuccess
+              _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
+              logRefSuccess
+              _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
+              logRefSuccess
+              _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
+-}
+              markComplete jobHandle
+            _otherTabType -> do
+              -- printDebug "[tableNgramsPostChartsAsync] no update for tabType = " tabType
+              markStarted 1 jobHandle
+              markFailedNoErr jobHandle
+
+  {-
+  { _ne_list        :: ListType
+  If we merge the parents/children we can potentially create cycles!
+  , _ne_parent      :: Maybe NgramsTerm
+  , _ne_children    :: MSet NgramsTerm
+  }
+  -}
+
+scoresRecomputeTableNgrams :: forall env err m.
+                              ( HasNodeStory env err m, HasNodeError err )
+                           => NodeId -> TabType -> ListId -> m Int
+scoresRecomputeTableNgrams nId tabType listId = do
+  tableMap <- getNgramsTableMap listId ngramsType
+  _ <- tableMap & v_data %%~ (setNgramsTableScores nId listId ngramsType)
+                           . Map.mapWithKey ngramsElementFromRepo
+
+  pure $ 1
+  where
+    ngramsType = ngramsTypeFromTabType tabType
+
+-- | Text search is deactivated for now for ngrams by doc only
+getTableNgramsDoc :: ( HasNodeStory env err m
+                     , HasNodeError err )
+                  => DocId -> TabType
+                  -> ListId -> Limit -> Maybe Offset
+                  -> Maybe ListType
+                  -> Maybe MinSize -> Maybe MaxSize
+                  -> Maybe OrderBy
+                  -> Maybe Text -- full text search
+                  -> m (VersionedWithCount NgramsTable)
+getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orderBy _mt = do
+  ns <- selectNodesWithUsername NodeList userMaster
+  let ngramsType = ngramsTypeFromTabType tabType
+  ngs <- selectNgramsByDoc (ns <> [listId]) dId ngramsType
+  let searchQueryFn (NgramsTerm nt) = Set.member nt (Set.fromList ngs)
+      searchQuery = NgramsSearchQuery {
+                    _nsq_limit       = limit_
+                  , _nsq_offset      = offset
+                  , _nsq_listType    = listType
+                  , _nsq_minSize     = minSize
+                  , _nsq_maxSize     = maxSize
+                  , _nsq_orderBy     = orderBy
+                  , _nsq_searchQuery = searchQueryFn
+                  }
+  getTableNgrams dId listId tabType searchQuery
+
+

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

+
+module Gargantext.API.Server.Named.Private where
+
+import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
+import Gargantext.API.Admin.EnvTypes (Env)
+import Gargantext.API.Context
+import Gargantext.API.Count qualified as Count
+import Gargantext.API.Errors.Types
+import Gargantext.API.Members (members)
+import Gargantext.API.Ngrams.List qualified as List
+import Gargantext.API.Node
+import Gargantext.API.Node qualified as Tree
+import Gargantext.API.Node.Contact as Contact
+import Gargantext.API.Node.Corpus.Export qualified as CorpusExport
+import Gargantext.API.Node.Document.Export (documentExportAPI)
+import Gargantext.API.Node.Phylo.Export qualified as PhyloExport
+import Gargantext.API.Node.ShareURL ( shareURL )
+import Gargantext.API.Prelude
+import Gargantext.API.Routes (addCorpusWithForm, addCorpusWithQuery)
+import Gargantext.API.Routes.Named.Private qualified as Named
+import Gargantext.API.Server.Named.Ngrams
+import Gargantext.API.Server.Named.Viz qualified as Viz
+import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Prelude
+import Servant.Auth.Swagger ()
+import Servant.Server.Generic (AsServerT)
+
+
+---------------------------------------------------------------------
+-- | Server declarations
+
+-- TODO-SECURITY admin only: withAdmin
+-- Question: How do we mark admins?
+serverGargAdminAPI :: Named.GargAdminAPI (AsServerT (GargM Env BackendInternalError))
+serverGargAdminAPI = Named.GargAdminAPI
+  { rootsEp       = roots
+  , adminNodesAPI = nodesAPI
+  }
+
+
+serverPrivateGargAPI'
+  :: AuthenticatedUser -> Named.GargPrivateAPI' (AsServerT (GargM Env BackendInternalError))
+serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
+       =  Named.GargPrivateAPI'
+       { gargAdminAPI      = serverGargAdminAPI
+       , nodeEp            = nodeAPI authenticatedUser
+       , contextEp         = contextAPI (Proxy :: Proxy HyperdataAny) authenticatedUser
+       , corpusNodeAPI     = corpusNodeAPI authenticatedUser
+       , corpusNodeNodeAPI = nodeNodeAPI (Proxy :: Proxy HyperdataAny) authenticatedUser
+       , corpusExportAPI   = CorpusExport.getCorpus
+       , annuaireEp        = annuaireNodeAPI authenticatedUser
+       , contactAPI        = contactAPI authenticatedUser
+       , tableNgramsAPI    = apiNgramsTableDoc authenticatedUser
+       , phyloExportAPI    = PhyloExport.api userNodeId
+       , documentExportAPI = documentExportAPI userNodeId
+       , countAPI          = Count.countAPI
+       , graphAPI          = Viz.graphAPI authenticatedUser userId
+       , treeAPI           = Tree.treeAPI authenticatedUser
+       , treeFlatAPI       = Tree.treeFlatAPI authenticatedUser
+       , membersAPI        = members
+       , addWithFormEp     = addCorpusWithForm (RootId userNodeId)
+       , addWithQueryEp    = addCorpusWithQuery (RootId userNodeId)
+       , listGetAPI        = List.getAPI
+       , listJsonAPI       = List.jsonAPI
+       , listCsvAPI        = List.csvAPI
+       , shareUrlEp        = shareURL
+       }

src/Gargantext/API/Public.hs → src/Gargantext/API/Server/Named/Public.hs

-{-|
-Module      : Gargantext.API.Public
-Description :
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
 
--}
-
-{-# LANGUAGE TypeOperators       #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Gargantext.API.Public
-      where
+module Gargantext.API.Server.Named.Public (
+  serverPublicGargAPI
+  ) where
 
 import Control.Lens ((^?), _Just)
-import Data.Aeson ( Options(sumEncoding), genericParseJSON, defaultOptions, genericToJSON )
 import Data.List qualified as List
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
-import Data.Swagger (ToSchema)
-import Gargantext.API.Node.File (FileApi, fileApi)
-import Gargantext.API.Prelude (serverError, GargServer)
+import Gargantext.API.Node.File (fileApi)
+import Gargantext.API.Prelude (serverError, IsGargServer)
+import Gargantext.API.Public.Types
 import Gargantext.Core.Utils.DateUtils (utc2year)
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( hc_fields )
-import Gargantext.Database.Admin.Types.Hyperdata.Folder ( HyperdataFolder )
 import Gargantext.Database.Admin.Types.Hyperdata.CorpusField
+import Gargantext.Database.Admin.Types.Hyperdata.Folder ( HyperdataFolder )
 import Gargantext.Database.Admin.Types.Node ( NodeId(..), Node, unNodeId )
 import Gargantext.Database.Prelude (Cmd, DBCmd)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Table.NodeNode (selectPublicNodes)
 import Gargantext.Database.Schema.Node ( NodePoly(..), node_date, node_hyperdata ) -- (NodePoly(..))
 import Gargantext.Prelude
-import Gargantext.Utils.Aeson qualified as GUA
 import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
-
-------------------------------------------------------------------------
-type API =  API_Home
-       :<|> API_Node
-
-api :: Text -> GargServer API
-api baseUrl = (api_home baseUrl)
-          :<|> api_node
-
--------------------------------------------------------------------------
-type API_Home = Summary " Public Home API"
-         :> Get '[JSON] [PublicData]
-
-api_home :: Text -> GargServer API_Home
-api_home baseUrl = catMaybes
+import Servant.Server.Generic (AsServerT)
+import qualified Gargantext.API.Routes.Named.File as Named
+import qualified Gargantext.API.Routes.Named.Public as Named
+
+serverPublicGargAPI :: IsGargServer env err m => Text -> Named.GargPublicAPI (AsServerT m)
+serverPublicGargAPI baseUrl =
+  Named.GargPublicAPI
+    { publicHomeAPI = api_home baseUrl
+    , publicNodeAPI = Named.NodeAPI api_node
+    }
+
+api_home :: IsGargServer env err m => Text -> Named.HomeAPI (AsServerT m)
+api_home baseUrl = Named.HomeAPI $ catMaybes
    <$> map (toPublicData baseUrl)
    <$> filterPublicDatas
    <$> selectPublic
 
--------------------------------------------------------------------------
-type API_Node = Summary " Public Node API"
-              :> Capture "node" NodeId
-              :> "file" :> FileApi
-
-api_node :: NodeId -> GargServer FileApi
-api_node nId = do
+api_node :: IsGargServer env err m => NodeId -> Named.FileAPI (AsServerT m)
+api_node nId = Named.FileAPI $ do
   pubNodes <- publicNodes
   -- TODO optimize with SQL
   case Set.member nId pubNodes of
@@ -120,37 +97,3 @@ toPublicData base (n , mn) = do
            <>   "/public/"
            <> (show $ (maybe 0 unNodeId $ head mn'))
            <> "/file/download"
-
-
-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/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  = Named.GraphAsyncAPI $ 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/API/Table.hs

@@ -31,15 +31,15 @@ Node API
 module Gargantext.API.Table
   where
 
-import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
 import Data.Text qualified as T
 import Gargantext.API.HashedResponse
 import Gargantext.API.Ngrams.Types (TabType(..))
-import Gargantext.API.Prelude (GargServer)
+import Gargantext.API.Prelude (IsGargServer)
+import Gargantext.API.Routes.Named.Table qualified as Named
+import Gargantext.API.Table.Types
 import Gargantext.Core.Text.Corpus.Query (RawQuery, parseQuery, getRawQuery)
 import Gargantext.Core.Types (TableResult(..))
 import Gargantext.Core.Types.Query (Offset, Limit)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.Action.Search
 import Gargantext.Database.Admin.Types.Node hiding (ERROR, DEBUG)
@@ -49,8 +49,7 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Prelude
 import Gargantext.System.Logging
 import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import Servant.Server.Generic
 
 ------------------------------------------------------------------------
 
@@ -70,33 +69,12 @@ type TableApi = Summary "Table API"
                 :> QueryParam "tabType" TabType
                 :> Get '[JSON] Text
 
-data TableQuery = TableQuery
-  { tq_offset       :: Offset
-  , tq_limit        :: Limit
-  , tq_orderBy      :: OrderBy
-  , tq_view         :: TabType
-  , tq_query        :: RawQuery
-  } deriving (Generic)
-
-type FacetTableResult = TableResult FacetDoc
-
-$(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" }]
-
-
-tableApi :: NodeId -> GargServer TableApi
-tableApi id' = getTableApi id'
-          :<|> postTableApi id'
-          :<|> getTableHashApi id'
+tableApi :: IsGargServer env err m => NodeId -> Named.TableAPI (AsServerT m)
+tableApi id' = Named.TableAPI
+  { getTableEp  = getTableApi id'
+  , postTableEp = postTableApi id'
+  , hashTableEp = getTableHashApi id'
+  }
 
 
 getTableApi :: (CmdM env err m, HasNodeError err, MonadLogger m)

src/Gargantext/API/Table/Types.hs

+{-# LANGUAGE TemplateHaskell #-}
+module Gargantext.API.Table.Types (
+    TableQuery(..)
+  , FacetTableResult
+  ) where
+
+import Data.Swagger (ToSchema(..), genericDeclareNamedSchema)
+import Gargantext.API.Ngrams.Types (TabType(..))
+import Gargantext.Core.Text.Corpus.Query (RawQuery)
+import Gargantext.Core.Types (TableResult(..))
+import Gargantext.Core.Types.Query (Offset, Limit)
+import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
+import Gargantext.Database.Query.Facet (FacetDoc , OrderBy(..))
+import Gargantext.Prelude
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+
+data TableQuery = TableQuery
+  { tq_offset       :: Offset
+  , tq_limit        :: Limit
+  , tq_orderBy      :: OrderBy
+  , tq_view         :: TabType
+  , tq_query        :: RawQuery
+  } deriving (Generic)
+
+type FacetTableResult = TableResult FacetDoc
+
+$(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/ThrowAll.hs

@@ -10,43 +10,50 @@ Portability : POSIX
 -}
 
 {-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase             #-}
 {-# LANGUAGE MonoLocalBinds         #-}
 {-# LANGUAGE TypeOperators          #-}
 {-# LANGUAGE UndecidableInstances   #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
 
 module Gargantext.API.ThrowAll where
 
 import Control.Lens ((#))
+import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Errors.Types
 import Gargantext.API.Prelude
-import Gargantext.API.Routes (GargPrivateAPI, serverPrivateGargAPI')
+import Gargantext.API.Routes.Named.Private qualified as Named
+import Gargantext.API.Server.Named.Private qualified as Named
+import Gargantext.Database.Admin.Types.Node (UserId (..))
 import Gargantext.Prelude
 import Servant
 import Servant.Auth.Server (AuthResult(..))
-
-class ThrowAll' e a | a -> e where
-  -- | 'throwAll' is a convenience function to throw errors across an entire
-  -- sub-API
-  --
-  --
-  -- > throwAll err400 :: Handler a :<|> Handler b :<|> Handler c
-  -- >    == throwError err400 :<|> throwError err400 :<|> err400
-  throwAll' :: e -> a
-
-instance (ThrowAll' e a, ThrowAll' e b) => ThrowAll' e (a :<|> b) where
-  throwAll' e = throwAll' e :<|> throwAll' e
-
--- Really this shouldn't be necessary - ((->) a) should be an instance of
--- MonadError, no?
-instance {-# OVERLAPPING #-} ThrowAll' e b => ThrowAll' e (a -> b) where
-  throwAll' e = const $ throwAll' e
-
-instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where
-  throwAll' = throwError
-
-serverPrivateGargAPI
-  :: ServerT GargPrivateAPI (GargM Env BackendInternalError)
-serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
-serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
+import Servant.Server.Generic (AsServerT)
+import Servant.API.Generic ()
+
+
+throwAll' :: forall err m routes. ( MonadError err m
+         , HasServerError err
+         , HasServer (NamedRoutes routes) '[]
+         , Generic (routes (AsServerT m))
+         ) => err
+           -> routes (AsServerT m)
+           -> routes (AsServerT m)
+throwAll' errCode server =
+  hoistServer (Proxy @(NamedRoutes routes)) f server
+  where
+    f :: forall a. m a -> m a
+    f = const (throwError errCode)
+
+serverPrivateGargAPI :: Named.GargPrivateAPI (AsServerT (GargM Env BackendInternalError))
+serverPrivateGargAPI = Named.GargPrivateAPI $ \case
+  (Authenticated auser) -> Named.serverPrivateGargAPI' auser
+  -- In the code below we just needed a mock 'AuthenticatedUser' to make the type check, but
+  -- they will never be evaluated.
+  _                     -> throwAll' (_ServerError # err401)
+                             $ Named.serverPrivateGargAPI' (AuthenticatedUser 0 (UnsafeMkUserId 0))
 -- Here throwAll' requires a concrete type for the monad.

src/Gargantext/API/Viz/Types.hs

+
+module Gargantext.API.Viz.Types (
+    SVG(..)
+  , PhyloData(..)
+  ) where
+
+import Data.Aeson
+import Gargantext.Core.Viz.Phylo (PhyloConfig(..))
+import Data.ByteString qualified as DB
+import Data.ByteString.Lazy qualified as DBL
+import Data.Swagger
+import Gargantext.Core.Types (TODO(..))
+import Gargantext.Core.Types.Phylo (GraphData(..))
+import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
+import Gargantext.Prelude
+import Network.HTTP.Media ((//), (/:))
+import Prelude qualified
+import Servant
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+
+newtype SVG = SVG DB.ByteString
+--instance Show a => MimeRender PlainText a where mimeRender _ val = cs ("" <> show val)
+instance Accept SVG where contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
+instance MimeRender SVG SVG where mimeRender _ (SVG s) = DBL.fromStrict s
+instance MimeUnrender SVG SVG where mimeUnrender _ lbs = Right $ SVG (DBL.toStrict lbs)
+instance Prelude.Show SVG where show (SVG a) = show a
+instance ToSchema SVG where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
+
+------------------------------------------------------------------------
+instance ToSchema Value where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
+
+------------------------------------------------------------------------
+
+-- | This type is emitted by the backend and the frontend expects to deserialise it
+-- as a 'PhyloJSON'. see module 'Gargantext.Components.PhyloExplorer.JSON' of the
+-- 'purescript-gargantext' package.
+data PhyloData = PhyloData { pd_corpusId :: NodeId
+                           , pd_listId   :: NodeId
+                           , pd_data     :: GraphData
+                           , pd_config   :: PhyloConfig
+                           }
+  deriving (Generic, Show, Eq)
+
+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
+

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

@@ -20,12 +20,11 @@ module Gargantext.Core.Viz.Graph.API
 
 import Control.Lens (set, _Just, (^?), at)
 import Data.HashMap.Strict qualified as HashMap
-import Data.Swagger ( ToSchema )
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types ( JobLog )
 import Gargantext.API.Errors.Types ( BackendInternalError )
 import Gargantext.API.Ngrams.Tools
-import Gargantext.API.Prelude (GargM, GargServer)
+import Gargantext.API.Prelude (GargM)
 import Gargantext.Core.Methods.Similarities (Similarity(..), GraphMetric(..), withMetric)
 import Gargantext.Core.NodeStory.Types ( HasNodeStory, a_version, unNodeStory, NodeListStory )
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
@@ -60,23 +59,6 @@ type GraphAPI   =  Get  '[JSON] HyperdataGraphAPI
               :<|> "gexf" :> Get '[XML] (Headers '[Servant.Header "Content-Disposition" Text] Graph)
               :<|> "versions" :> GraphVersionsAPI
 
-data GraphVersions =
-  GraphVersions { gv_graph :: Maybe Int
-                , gv_repo :: Int
-                }
-   deriving (Show, Generic)
-
-instance FromJSON GraphVersions
-instance ToJSON GraphVersions
-instance ToSchema GraphVersions
-
-graphAPI :: UserId -> NodeId -> ServerT GraphAPI (GargM Env BackendInternalError)
-graphAPI userId n = getGraph n
-          :<|> graphAsync        n
-          :<|> graphClone        userId n
-          :<|> getGraphGexf      n
-          :<|> graphVersionsAPI  userId n
-
 ------------------------------------------------------------------------
 --getGraph :: UserId -> NodeId -> GargServer HyperdataGraphAPI
 getGraph :: HasNodeStory env err m
@@ -273,11 +255,6 @@ type GraphVersionsAPI = Summary "Graph versions"
                    :<|> Summary "Recompute graph version"
                         :> Post '[JSON] Graph
 
-graphVersionsAPI :: UserId -> NodeId -> GargServer GraphVersionsAPI
-graphVersionsAPI u n =
-           graphVersions u n
-      :<|> recomputeVersions n
-
 graphVersions :: (HasNodeStory env err m)
               => UserId
               -> NodeId

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

src/Gargantext/Core/Viz/Phylo/API.hs

@@ -19,12 +19,11 @@ module Gargantext.Core.Viz.Phylo.API
 
 import Data.Aeson
 import Data.Aeson.Types (parseEither)
-import Data.ByteString qualified as DB
-import Data.ByteString.Lazy qualified as DBL
 import Data.Swagger
 import Data.Text qualified as T
 import Gargantext.API.Prelude
-import Gargantext.Core.Types (TODO(..))
+import Gargantext.API.Routes.Named.Viz qualified as Named
+import Gargantext.API.Viz.Types
 import Gargantext.Core.Types.Phylo (GraphData(..))
 import Gargantext.Core.Viz.LegacyPhylo hiding (Phylo(..))
 import Gargantext.Core.Viz.Phylo (PhyloConfig(..), defaultConfig, _phylo_param, _phyloParam_config)
@@ -34,14 +33,12 @@ import Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType, defaultList)
+import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Prelude
-import Network.HTTP.Media ((//), (/:))
-import Prelude qualified
 import Servant
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
+import Servant.Server.Generic (AsServerT)
 import Web.HttpApiData (readTextData)
-import Gargantext.Database.Query.Table.Node.Error
 
 ------------------------------------------------------------------------
 type PhyloAPI = Summary "Phylo API"
@@ -50,57 +47,14 @@ type PhyloAPI = Summary "Phylo API"
             :<|> PostPhylo
 
 
-phyloAPI :: PhyloId -> GargServer PhyloAPI
-phyloAPI n = getPhylo  n
-        :<|> postPhylo n
+phyloAPI :: IsGargServer err env m => PhyloId -> Named.PhyloAPI (AsServerT m)
+phyloAPI n = Named.PhyloAPI
+  { getPhyloEp  = getPhylo n
+  , postPhyloEp = postPhylo n
+  }
         -- :<|> putPhylo  n
         -- :<|> deletePhylo  n
 
-newtype SVG = SVG DB.ByteString
---instance Show a => MimeRender PlainText a where mimeRender _ val = cs ("" <> show val)
-instance Accept SVG where contentType _ = "SVG" // "image/svg+xml" /: ("charset", "utf-8")
-instance MimeRender SVG SVG where mimeRender _ (SVG s) = DBL.fromStrict s
-instance MimeUnrender SVG SVG where mimeUnrender _ lbs = Right $ SVG (DBL.toStrict lbs)
-instance Prelude.Show SVG where show (SVG a) = show a
-instance ToSchema SVG where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
-
-------------------------------------------------------------------------
-instance ToSchema Value where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
-
-------------------------------------------------------------------------
-
--- | This type is emitted by the backend and the frontend expects to deserialise it
--- as a 'PhyloJSON'. see module 'Gargantext.Components.PhyloExplorer.JSON' of the
--- 'purescript-gargantext' package.
-data PhyloData = PhyloData { pd_corpusId :: NodeId
-                           , pd_listId   :: NodeId
-                           , pd_data     :: GraphData
-                           , pd_config   :: PhyloConfig
-                           }
-  deriving (Generic, Show, Eq)
-
-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
-
 type GetPhylo =  QueryParam "listId"      ListId
               :> QueryParam "level"       Level
               :> QueryParam "minSizeBranch" MinSizeBranch
@@ -126,8 +80,8 @@ type GetPhylo =  QueryParam "listId"      ListId
 -- Add real text processing
 -- Fix Filter parameters
 -- TODO fix parameters to default config that should be in Node
-getPhylo :: PhyloId -> GargServer GetPhylo
-getPhylo phyloId lId _level _minSizeBranch = do
+getPhylo :: IsGargServer err env m => PhyloId -> Named.GetPhylo (AsServerT m)
+getPhylo phyloId = Named.GetPhylo $ \lId _level _minSizeBranch -> do
   corpusId <- maybe (nodeLookupError $ NodeParentDoesNotExist phyloId) pure
               =<< getClosestParentIdByType phyloId NodeCorpus
   listId   <- case lId of
@@ -167,8 +121,8 @@ type PostPhylo =  QueryParam "listId" ListId
           --     :> ReqBody '[JSON] PhyloQueryBuild
                :> (Post '[JSON] NodeId)
 
-postPhylo :: PhyloId -> GargServer PostPhylo
-postPhylo phyloId _lId = do
+postPhylo :: IsGargServer err env m => PhyloId -> Named.PostPhylo (AsServerT m)
+postPhylo phyloId = Named.PostPhylo $ \_lId -> do
   -- TODO get Reader settings
   -- s <- ask
   -- let

test/Test/Offline/JSON.hs

@@ -11,11 +11,10 @@ import Data.ByteString qualified as B
 import Data.ByteString.Lazy.Char8 qualified as C8
 import Data.Either
 import Gargantext.API.Errors
-import Gargantext.API.Node.Corpus.New
 import Gargantext.API.Node.Corpus.Types
 import Gargantext.API.Node.Types
+import Gargantext.API.Viz.Types
 import Gargantext.Core.Types.Phylo
-import Gargantext.Core.Viz.Phylo.API
 import Gargantext.Database.Admin.Types.Node
 import Paths_gargantext
 import Prelude