Commit 5c37bca9 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge remote-tracking branch 'origin/client-graphql-endpoint' into dev-merge

parents 920d3ec4 8fe83448
{-# OPTIONS_GHC -freduction-depth=0 #-} {-# OPTIONS_GHC -freduction-depth=0 #-}
{-# OPTIONS_GHC -O0 #-} {-# OPTIONS_GHC -O0 #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.API.Client where module Gargantext.API.Client where
import Data.Int import Data.Int
import Data.Maybe import Data.Maybe
import Data.Map (Map) import Data.Map (Map)
import Data.Morpheus.Types.IO (GQLRequest, GQLResponse)
import Data.Proxy import Data.Proxy
import Data.Text (Text) import Data.Text (Text)
import Data.Time.Clock import Data.Time.Clock
...@@ -15,6 +17,7 @@ import Gargantext.API.Admin.Auth.Types hiding (Token) ...@@ -15,6 +17,7 @@ import Gargantext.API.Admin.Auth.Types hiding (Token)
import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Count import Gargantext.API.Count
import Gargantext.API.EKG import Gargantext.API.EKG
import qualified Gargantext.API.GraphQL as GraphQL
import Gargantext.API.HashedResponse import Gargantext.API.HashedResponse
import Gargantext.API.Ngrams as Ngrams import Gargantext.API.Ngrams as Ngrams
import Gargantext.API.Ngrams.NgramsTree import Gargantext.API.Ngrams.NgramsTree
...@@ -420,6 +423,13 @@ getMetricsSample :: ClientM Sample ...@@ -420,6 +423,13 @@ getMetricsSample :: ClientM Sample
-- | open @<backend:port\/ekg\/index.html@ to see a list of metrics -- | open @<backend:port\/ekg\/index.html@ to see a list of metrics
getMetricSample :: [Text] -> ClientM Value getMetricSample :: [Text] -> ClientM Value
-- * graphql api
postGraphQL :: Token -> GQLRequest -> ClientM GQLResponse
postGraphQL = client (fstEndpoint (flatten GraphQL.gqapi))
where fstEndpoint :: Proxy (a :<|> b) -> Proxy a
fstEndpoint _ = Proxy
-- * unpacking of client functions to derive all the individual clients -- * unpacking of client functions to derive all the individual clients
clientApi :: Client ClientM (Flat GargAPI) clientApi :: Client ClientM (Flat GargAPI)
......
...@@ -29,6 +29,7 @@ import Data.Morpheus.Types ...@@ -29,6 +29,7 @@ import Data.Morpheus.Types
, RootResolver(..) , RootResolver(..)
, Undefined(..) , Undefined(..)
) )
import Data.Proxy
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser) import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
import Gargantext.API.Admin.Orchestrator.Types (JobLog) import Gargantext.API.Admin.Orchestrator.Types (JobLog)
import Gargantext.API.Prelude (HasJobEnv') import Gargantext.API.Prelude (HasJobEnv')
...@@ -136,6 +137,9 @@ type Playground = Get '[HTML] ByteString ...@@ -136,6 +137,9 @@ type Playground = Get '[HTML] ByteString
type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
:> "gql" :> (GQAPI :<|> Playground) :> "gql" :> (GQAPI :<|> Playground)
gqapi :: Proxy API
gqapi = Proxy
-- serveEndpoint :: -- serveEndpoint ::
-- ( SubApp ServerApp e -- ( SubApp ServerApp e
-- , PubApp e -- , PubApp e
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment