Merge branch 'dev' into 341-dev-websockets

CHANGELOG.md

+## Version 0.0.7.1.6.1
+
+* [FRONT][FIX][Display Phylomemy parameters (#580)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/580)
+* [BACK][FIX][Consider integrating Servant named routes (#271)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/271)
+
 ## Version 0.0.7.1.6
 
 * [BACK][REFACT][Consider integrating Servant named routes (#271)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/271)

gargantext.cabal

@@ -5,7 +5,7 @@ cabal-version: 3.4
 -- see: https://github.com/sol/hpack
 
 name:           gargantext
-version: 0.0.7.1.6
+version: 0.0.7.1.6.1
 synopsis:       Search, map, share
 description:    Please see README.md
 category:       Data

src/Gargantext/API/GraphQL.hs

@@ -15,6 +15,8 @@ Portability : POSIX
 {-# LANGUAGE KindSignatures #-}  -- for use of Endpoint (name :: Symbol)
 {-# LANGUAGE PartialTypeSignatures #-}  -- to automatically use suggested type hole signatures during compilation
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Gargantext.API.GraphQL where
 
@@ -46,16 +48,9 @@ import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Database.Prelude (CmdCommon)
 import Gargantext.Prelude hiding (ByteString)
 import Servant
-  ( (:<|>) (..)
-  , (:>)
-  , Get
-  , JSON
-  , Post
-  , ReqBody
-  ,  ServerT
-  )
 import Servant.Auth qualified as SA
 import Servant.Auth.Server qualified as SAS
+import Servant.Server.Generic
 
 
 -- | Represents possible GraphQL queries.
@@ -127,7 +122,7 @@ rootResolver authenticatedUser policyManager =
                             , user_infos          = GQLUserInfo.resolveUserInfos authenticatedUser policyManager
                             , users               = GQLUser.resolveUsers authenticatedUser policyManager
                             , tree                = GQLTree.resolveTree authenticatedUser policyManager
-                            , team                = GQLTeam.resolveTeam 
+                            , team                = GQLTeam.resolveTeam
                             , tree_branch         = GQLTree.resolveBreadcrumb }
     , mutationResolver = Mutation { update_user_info       = GQLUserInfo.updateUserInfo
                                   , update_user_pubmed_api_key = GQLUser.updateUserPubmedAPIKey
@@ -151,34 +146,37 @@ app authenticatedUser policyManager = deriveApp (rootResolver authenticatedUser
 -- servant.
 
 -- | Servant route for the app we defined above.
-type GQAPI = ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
--- type Schema = "schema" :> Get '[PlainText] Text
--- | Servant route for the playground.
-type Playground = Get '[HTML] ByteString
--- type API' (name :: Symbol) = name :> (GQAPI :<|> Schema :<|> Playground)
--- | Our API consists of `GQAPI` and `Playground`.
-type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
-            :> "gql" :> (PolicyChecked GQAPI :<|> Playground)
+newtype GQAPI mode = GQAPI
+  { gqApi :: mode :- ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
+  } deriving Generic
 
-gqapi :: Proxy API
+-- | Servant route for the playground.
+newtype Playground mode = Playground
+  { playground :: mode :- Get '[HTML] ByteString
+  } deriving Generic
+
+newtype GraphQLAPI mode = GraphQLAPI
+  { graphQLAPI :: mode :- SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
+                       :> "gql"
+                       :> NamedRoutes GraphQLAPIEndpoints
+  } deriving Generic
+
+data GraphQLAPIEndpoints mode = GraphQLAPIEndpoints
+  { gqApiEp      :: mode :- PolicyChecked (NamedRoutes GQAPI)
+  , playgroundEp :: mode :- NamedRoutes Playground
+  }
+  deriving Generic
+
+gqapi :: Proxy (ToServantApi GraphQLAPI)
 gqapi = Proxy
 
--- serveEndpoint ::
---   ( SubApp ServerApp e
---   , PubApp e
---   ) =>
---   [e -> IO ()] ->
---   App e IO ->
---   Server (API name)
--- serveEndpoint publish app' = (liftIO . httpPubApp publish app') :<|> withSchema app' :<|> pure httpPlayground
---
--- withSchema :: (Applicative f) => App e m -> f Text
--- withSchema = pure . LT.toStrict . decodeUtf8 . render
-
 -- | Implementation of our API.
---api :: Server API
 api
   :: (Typeable env, CmdCommon env, HasJobEnv' env, HasSettings env)
-  => ServerT API (GargM env BackendInternalError)
-api (SAS.Authenticated auser) = (httpPubApp [] . app auser) :<|> pure httpPlayground
-api _                         = panicTrace "401 in graphql" -- SAS.throwAll (_ServerError # err401)
+  => GraphQLAPI (AsServerT (GargM env BackendInternalError))
+api = GraphQLAPI $ \case
+  (SAS.Authenticated auser)
+    -> GraphQLAPIEndpoints { gqApiEp      = GQAPI . httpPubApp [] . app auser
+                           , playgroundEp = Playground $ pure httpPlayground
+                           }
+  _ -> panicTrace "401 in graphql" -- SAS.throwAll (_ServerError # err401)

src/Gargantext/API/Routes/Named.hs

@@ -24,7 +24,7 @@ import GHC.Generics
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
 import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.GraphQL qualified as GraphQL
+import Gargantext.API.GraphQL
 import Gargantext.API.Routes.Named.Private
 import Gargantext.API.Routes.Named.Public
 import Gargantext.API.Routes.Types
@@ -43,7 +43,7 @@ newtype API mode = API
 data NamedAPI mode = NamedAPI
   { swaggerAPI  :: mode :- SwaggerSchemaUI "swagger-ui" "swagger.json"
   , backendAPI  :: mode :- NamedRoutes BackEndAPI
-  , graphqlAPI  :: mode :- GraphQL.API -- FIXME(adn) convert to named!
+  , graphqlAPI  :: mode :- NamedRoutes GraphQLAPI -- FIXME(adn) convert to named!
   , frontendAPI :: mode :- FrontEndAPI
   , wsAPI       :: mode :- NamedRoutes Dispatcher.WSAPI
   } deriving Generic

src/Gargantext/API/Server/Named.hs

@@ -16,7 +16,7 @@ import Gargantext.API.Admin.EnvTypes (Env, env_dispatcher)
 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.GraphQL as GraphQL
 import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
 import Gargantext.API.Routes.Named
@@ -57,7 +57,7 @@ server env =
                       (transformJSON errScheme)
                       (serverGargAPI (env ^. hasConfig . gc_url_backend_api))
      , graphqlAPI = hoistServerWithContext
-                      (Proxy :: Proxy GraphQL.API)
+                      (Proxy :: Proxy (NamedRoutes GraphQLAPI))
                       (Proxy :: Proxy AuthContext)
                       (transformJSONGQL errScheme)
                       GraphQL.api