Skip to content

haskell-gargantext
haskell-gargantext
Commit 6240e820 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli
1 Browse files
Options

Named server handlers 

This big commit ties the knot with the named _routes_ by providing
concrete server (i.e. handlers) implementations.
parent 144dce2d
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 1572 additions and 1459 deletions
gargantext.cabal
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -11,9 +11,36 @@ Portability : POSIX
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Admin.Auth.Types
where
import qualified Data.Aeson.TH as JSON
( -- * Types
AuthRequest(..)
, AuthResponse(..)
, Token
, TreeId
, CheckAuth(..)
, AuthenticatedUser(..)
, AuthContext
, AuthenticationError(..)
, PathId(..)
, Email
, Password
, ForgotPasswordRequest(..)
, ForgotPasswordResponse(..)
, ForgotPasswordAsyncParams(..)
, ForgotPasswordGet(..)
-- * Lenses
, auth_node_id
, auth_user_id
, authRes_token
, authRes_tree_id
, authRes_user_id
-- * Combinators
) where
import Crypto.JWT qualified as Jose
import Data.Aeson.TH qualified as JSON
import Data.Aeson.Types (genericParseJSON, defaultOptions, genericToJSON)
import Data.List (tail)
import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
import Gargantext.Core.Types.Individu (Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
......@@ -23,7 +50,6 @@ import Gargantext.Prelude hiding (reverse)
import Servant.Auth.Server
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Crypto.JWT as Jose
---------------------------------------------------
......@@ -106,6 +132,15 @@ data ForgotPasswordGet = ForgotPasswordGet {_fpGet_password :: Password}
instance ToSchema ForgotPasswordGet where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpGet_")
newtype ForgotPasswordAsyncParams =
ForgotPasswordAsyncParams { email :: Text }
deriving (Generic, Show)
instance FromJSON ForgotPasswordAsyncParams where
parseJSON = genericParseJSON defaultOptions
instance ToJSON ForgotPasswordAsyncParams where
toJSON = genericToJSON defaultOptions
instance ToSchema ForgotPasswordAsyncParams
--
-- Lenses
--
......
src/Gargantext/API/Admin/EnvTypes.hs
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
, FromJSON a
, ToJSON a
) => proxy a
-> AuthenticatedUser
-> ContextId
-> GargServer (ContextAPI a)
contextAPI p uId id' = withAccess (Proxy :: Proxy (ContextAPI a)) Proxy uId (PathNode $ contextId2NodeId id') contextAPI'
contextAPI :: ( IsGargServer env err m
, JSONB a
, FromJSON a
, ToJSON a )
=> Proxy a
-> AuthenticatedUser
-> ContextId
-> Named.ContextAPI a (AsServerT m)
contextAPI p uId id' =
withNamedAccess uId (PathNode $ contextId2NodeId id') contextAPI'
where
contextAPI' :: GargServer (ContextAPI a)
contextAPI' = getContextWith id' p
contextAPI' = Named.ContextAPI $ getContextWith id' p
src/Gargantext/API/Count.hs
View file @ 6240e820
......@@ -17,143 +17,17 @@ Count API part of Gargantext.
{-# LANGUAGE DeriveAnyClass #-}
module Gargantext.API.Count (
CountAPI
, Scraper(..)
, QueryBool(..)
, Query(..)
, Message(..)
, Code
, Error
, Errors
, Counts(..)
, Count(..)
-- * functions
, count
, scrapers
countAPI
) where
import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
import Data.Text (pack)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.API.Count.Types
import Gargantext.API.Routes.Named.Count qualified as Named
import Gargantext.Prelude
import Servant (JSON, Post)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary(..))
import Servant.Server.Generic (AsServerT)
-----------------------------------------------------------------------
-- TODO-ACCESS: CanCount
-- TODO-EVENTS: No events as this is a read only query.
type CountAPI = Post '[JSON] Counts
-----------------------------------------------------------------------
data Scraper = Pubmed | Hal | IsTex | Isidore
deriving (Eq, Show, Generic, Enum, Bounded)
scrapers :: [Scraper]
scrapers = [minBound..maxBound]
instance FromJSON Scraper
instance ToJSON Scraper
instance Arbitrary Scraper where
arbitrary = elements scrapers
instance ToSchema Scraper
-----------------------------------------------------------------------
data QueryBool = QueryBool Text
deriving (Eq, Show, Generic)
queries :: [QueryBool]
queries = [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
--queries = [QueryBool (pack "(X + X') * (Y + Y') - (Z + Z')")]
instance Arbitrary QueryBool where
arbitrary = elements queries
instance FromJSON QueryBool
instance ToJSON QueryBool
instance ToSchema QueryBool
-----------------------------------------------------------------------
data Query = Query { query_query :: QueryBool
, query_name :: Maybe [Scraper]
}
deriving (Eq, Show, Generic)
instance FromJSON Query
instance ToJSON Query
instance Arbitrary Query where
arbitrary = elements [ Query q (Just n)
| q <- queries
, n <- take 10 $ permutations scrapers
]
instance ToSchema Query where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
-----------------------------------------------------------------------
type Code = Integer
type Error = Text
type Errors = [Error]
-----------------------------------------------------------------------
data Message = Message Code Errors
deriving (Eq, Show, Generic)
toMessage :: [(Code, Errors)] -> [Message]
toMessage = map (\(c,err) -> Message c err)
messages :: [Message]
messages = toMessage $ [ (400, ["Ill formed query "])
, (300, ["API connexion error "])
, (300, ["Internal Gargantext Error "])
] <> take 10 ( repeat (200, [""]))
instance Arbitrary Message where
arbitrary = elements messages
instance ToSchema Message
-----------------------------------------------------------------------
data Counts = Counts { results :: [Either Message Count]
} deriving (Eq, Show, Generic)
instance Arbitrary Counts where
arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
, Right (Count IsTex (Just 150))
, Right (Count Hal (Just 150))
]
]
instance ToSchema Counts
-----------------------------------------------------------------------
data Count = Count { count_name :: Scraper
, count_count :: Maybe Int
}
deriving (Eq, Show, Generic)
instance ToSchema Count where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
--instance Arbitrary Count where
-- arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
-----------------------------------------------------------------------
count :: Monad m => Query -> m Counts
count _ = undefined
--
-- JSON instances
--
instance FromJSON Message
instance ToJSON Message
$(deriveJSON (unPrefix "count_") ''Count)
instance FromJSON Counts
instance ToJSON Counts
countAPI :: Monad m => Query -> Named.CountAPI (AsServerT m)
countAPI _ = Named.CountAPI undefined
src/Gargantext/API/Count/Types.hs 0 → 100644
View file @ 6240e820
{-# 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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
This diff is collapsed.
src/Gargantext/API/Node/Contact.hs
View file @ 6240e820
......@@ -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 0 → 100644
View file @ 6240e820
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
View file @ 6240e820
......@@ -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,41 +55,46 @@ 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'
let
nt = fromMaybe NgramsTerms nt'
where
get_corpus :: IsGargServer env err m
=> Maybe ListId
-> Maybe NgramsType
-> m (Headers '[Header "Content-Disposition" Text] Corpus)
get_corpus lId nt' = do
let
nt = fromMaybe NgramsTerms nt'
listId <- case lId of
Nothing -> defaultList cId
Just l -> pure l
listId <- case lId of
Nothing -> defaultList cId
Just l -> pure l
-- FIXME(adn) Audit the usage of this, we are converting from a node
-- to a context id.
ns <- Map.fromList
<$> map (\n -> (nodeId2ContextId $ _context_id n, n))
<$> selectDocNodes cId
-- FIXME(adn) Audit the usage of this, we are converting from a node
-- to a context id.
ns <- Map.fromList
<$> map (\n -> (nodeId2ContextId $ _context_id n, n))
<$> selectDocNodes cId
repo <- getRepo [listId]
ngs <- getContextNgrams cId listId MapTerm nt repo
let -- uniqId is hash computed already for each document imported in database
r = Map.intersectionWith
(\a b -> DocumentExport.Document { _d_document = context2node a
, _d_ngrams = DocumentExport.Ngrams (Set.toList b) (hash b)
, _d_hash = d_hash a b }
) ns (Map.map (Set.map unNgramsTerm) ngs)
where
d_hash :: Context HyperdataDocument -> Set Text -> Text
d_hash _a b = hash [ -- fromMaybe "" (_hd_uniqId $ _context_hyperdata a),
hash b
]
pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".json")
$ Corpus { _c_corpus = Map.elems r
, _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
repo <- getRepo [listId]
ngs <- getContextNgrams cId listId MapTerm nt repo
let -- uniqId is hash computed already for each document imported in database
r = Map.intersectionWith
(\a b -> DocumentExport.Document { _d_document = context2node a
, _d_ngrams = DocumentExport.Ngrams (Set.toList b) (hash b)
, _d_hash = d_hash a b }
) ns (Map.map (Set.map unNgramsTerm) ngs)
where
d_hash :: Context HyperdataDocument -> Set Text -> Text
d_hash _a b = hash [ -- fromMaybe "" (_hd_uniqId $ _context_hyperdata a),
hash b
]
pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".json")
$ Corpus { _c_corpus = Map.elems r
, _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
getContextNgrams :: HasNodeError err
=> CorpusId
......
src/Gargantext/API/Node/Document/Export.hs
View file @ 6240e820
......@@ -17,9 +17,11 @@ import Data.Csv (encodeDefaultOrderedByNameWith, defaultEncodeOptions, encDelimi
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Time.Clock.System (getSystemTime, systemSeconds)
import Data.Time.LocalTime (getCurrentTimeZone, TimeZone (timeZoneMinutes))
import Data.Version (showVersion)
import Gargantext.API.Node.Document.Export.Types
import Gargantext.API.Prelude (GargNoServer, GargServer)
import Gargantext.API.Prelude (GargNoServer, IsGargServer)
import Gargantext.API.Routes.Named.Document qualified as Named
import Gargantext.Core (toDBid)
import Gargantext.Database.Admin.Types.Node (DocId, NodeId, NodeType(..))
import Gargantext.Database.Query.Facet (runViewDocuments, Facet(..))
......@@ -28,16 +30,19 @@ import Gargantext.Database.Query.Table.Node.User ( getNodeUser )
import Gargantext.Database.Schema.Node (NodePoly(..), node_user_id)
import Gargantext.Prelude
import Paths_gargantext qualified as PG -- cabal magic build module
import Servant ( addHeader, (:<|>)((:<|>)), Header, Headers(getResponse) )
import Data.Time.LocalTime (getCurrentTimeZone, TimeZone (timeZoneMinutes))
import Servant ( addHeader, Header, Headers(getResponse) )
import Servant.Server.Generic (AsServerT)
api :: NodeId
-- ^ The ID of the target user
-> DocId
-> GargServer API
api userNodeId dId = getDocumentsJSON userNodeId dId
:<|> getDocumentsJSONZip userNodeId dId
:<|> getDocumentsCSV userNodeId dId
documentExportAPI :: IsGargServer env err m
=> NodeId
-- ^ The ID of the target user
-> DocId
-> Named.DocumentExportAPI (AsServerT m)
documentExportAPI userNodeId dId = Named.DocumentExportAPI $ Named.DocumentExportEndpoints
{ exportJSONEp = getDocumentsJSON userNodeId dId
, exportJSONZipEp = getDocumentsJSONZip userNodeId dId
, exportCSVEp = getDocumentsCSV userNodeId dId
}
--------------------------------------------------
-- | Hashes are ordered by Set
......
src/Gargantext/API/Node/New.hs
View file @ 6240e820
......@@ -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 0 → 100644
View file @ 6240e820
module Gargantext.API.Node.New.Types (
PostNode(..)
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.Core.Types (NodeType (..))
import Test.QuickCheck
import Web.FormUrlEncoded
------------------------------------------------------------------------
data PostNode = PostNode { pn_name :: Text
, pn_typename :: NodeType}
deriving (Generic)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON PostNode
instance ToJSON PostNode
instance ToSchema PostNode
instance FromForm PostNode
instance ToForm PostNode
instance Arbitrary PostNode where
arbitrary = elements [PostNode "Node test" NodeCorpus]
src/Gargantext/API/Node/Phylo/Export.hs
View file @ 6240e820
......@@ -13,20 +13,24 @@ module Gargantext.API.Node.Phylo.Export
import Data.Aeson
import Data.Text qualified as T
import Gargantext.API.Node.Phylo.Export.Types
import Gargantext.API.Prelude (GargNoServer, GargServer)
import Gargantext.API.Prelude (GargNoServer, IsGargServer)
import Gargantext.API.Routes.Named.Viz qualified as Named
import Gargantext.Core.Viz.Phylo.API.Tools
import Gargantext.Core.Viz.Phylo.Example (phyloCleopatre)
import Gargantext.Database.Admin.Types.Node (PhyloId, NodeId,)
import Gargantext.Prelude
import Servant
import Servant.Server.Generic (AsServerT)
api :: NodeId
api :: IsGargServer env err m
=> NodeId
-- ^ The ID of the target user
-> PhyloId
-> GargServer API
api userNodeId dId = getPhyloJson userNodeId dId
:<|> getPhyloDot userNodeId dId
-> Named.PhyloExportAPI (AsServerT m)
api userNodeId dId = Named.PhyloExportAPI $ Named.PhyloExportEndpoints
{ exportPhyloJSONEp = getPhyloJson userNodeId dId
, exportPhyloDotEp = getPhyloDot userNodeId dId
}
getPhyloJson :: NodeId
-- ^ The ID of the target user
......@@ -54,4 +58,4 @@ getPhyloDot _ pId = do
, "GarganText_Phylo-"
, T.pack (show pId)
, ".dot" ])
phyloDot
\ No newline at end of file
phyloDot
src/Gargantext/API/Node/ShareURL.hs
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -77,6 +77,9 @@ type GargServerT env err m api = GargServerC env err m => ServerT api m
type GargServer api = forall env err m. MonadLogger m => GargServerT env err m api
class (MonadLogger m, GargServerC env err m) => IsGargServer env err m
-- = forall env err m. (MonadLogger m, GargServerC env err m) => AsServerT m
-- This is the concrete monad. It needs to be used as little as possible.
type GargM env err = ReaderT env (ExceptT err IO)
-- This is the server type using GargM. It needs to be used as little as possible.
......
src/Gargantext/API/Public/Types.hs 0 → 100644
View file @ 6240e820
module Gargantext.API.Public.Types (
PublicData(..)
, defaultPublicData
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.Utils.Aeson qualified as GUA
import Prelude
import Test.QuickCheck
data PublicData = PublicData
{ title :: Text
, abstract :: Text
, img :: Text
, url :: Text
, date :: Text
, database :: Text
, author :: Text
} | NoData { nodata:: Text}
deriving (Generic)
instance FromJSON PublicData where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON PublicData where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema PublicData
instance Arbitrary PublicData where
arbitrary = elements
$ replicate 6 defaultPublicData
defaultPublicData :: PublicData
defaultPublicData =
PublicData { title = "Title"
, abstract = foldl (<>) "" $ replicate 100 "abstract "
, img = "images/Gargantextuel-212x300.jpg"
, url = "https://.."
, date = "YY/MM/DD"
, database = "database"
, author = "Author" }
src/Gargantext/API/Routes.hs
View file @ 6240e820
......@@ -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
View file @ 6240e820
{-# 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 0 → 100644
View file @ 6240e820
{-# 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
View file @ 6240e820
......@@ -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
View file @ 6240e820
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Context where
module Gargantext.API.Routes.Named.Context (
-- * Routes types
ContextAPI(..)
) where
import GHC.Generics
import Gargantext.Database.Admin.Types.Node
import Servant
data ContextAPI mode a = ContextAPI
data ContextAPI a mode = ContextAPI
{ getNodeEp :: mode :- Get '[JSON] (Node a)
} deriving Generic
src/Gargantext/API/Routes/Named/Corpus.hs
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -10,7 +10,7 @@ module Gargantext.API.Routes.Named.Count (
import GHC.Generics
import Servant
import Gargantext.API.Count as X hiding (CountAPI)
import Gargantext.API.Count.Types as X
newtype CountAPI mode = CountAPI
......
src/Gargantext/API/Routes/Named/Document.hs
View file @ 6240e820
......@@ -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"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
:<|> "json.zip"
:> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
:<|> "csv"
:> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text) )
{ documentExportAPI :: mode :- Summary "Document Export" :> "export" :> NamedRoutes DocumentExportEndpoints
} deriving Generic
data DocumentExportEndpoints mode = DocumentExportEndpoints
{ exportJSONEp :: mode :- "json"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
, exportJSONZipEp :: mode :- "json.zip"
:> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
, exportCSVEp :: mode :- "csv"
:> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text)
} deriving Generic
newtype DocumentsFromWriteNodesAPI mode = DocumentsFromWriteNodesAPI
......@@ -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 0 → 100644
View file @ 6240e820
{-# 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
View file @ 6240e820
{-# 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
View file @ 6240e820
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.List where
module Gargantext.API.Routes.Named.List (
-- * Routes types
GETAPI(..)
, ListEndpoints(..)
, JSONAPI(..)
, CSVAPI(..)
) where
import Data.Text (Text)
import GHC.Generics
......@@ -16,14 +22,16 @@ newtype GETAPI mode = GETAPI
{ getListEp :: mode :- Summary "Get List"
:> "lists"
:> Capture "listId" ListId
:> ( "json"
:> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
:<|> "json.zip"
:> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
:<|> "csv"
:> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap) )
:> NamedRoutes ListEndpoints
} deriving Generic
data ListEndpoints mode = ListEndpoints
{ listJSONEp :: mode :- "json"
:> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
, listJSONZipEp :: mode :- "json.zip"
:> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
, listCSVEp :: mode :- "csv" :> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap)
} deriving Generic
newtype JSONAPI mode = JSONAPI
{ updateListJSONEp :: mode :- Summary "Update List"
......
src/Gargantext/API/Routes/Named/Node.hs
View file @ 6240e820
......@@ -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,11 +117,11 @@ newtype PostNodeAPI mode = PostNodeAPI
newtype ChildrenAPI a mode = ChildrenAPI
{ summaryChildrenEp :: Summary " Summary children"
:> QueryParam "type" NodeType
:> QueryParam "offset" Offset
:> QueryParam "limit" Limit
:> Get '[JSON] (NodeTableResult a)
{ summaryChildrenEp :: mode :- Summary " Summary children"
:> QueryParam "type" NodeType
:> QueryParam "offset" Offset
:> QueryParam "limit" Limit
:> Get '[JSON] (NodeTableResult a)
} deriving Generic
......@@ -137,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
View file @ 6240e820
{-# 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
View file @ 6240e820
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.API.Routes.Named.Public where
module Gargantext.API.Routes.Named.Public (
-- * Routes types
GargPublicAPI(..)
, HomeAPI(..)
, NodeAPI(..)
) where
import GHC.Generics
import Gargantext.API.Public qualified as Public
import Gargantext.API.Public.Types qualified as Public
import Gargantext.API.Routes.Named.File
import Gargantext.Database.Admin.Types.Node ( NodeId )
import Servant.API
data GargPublicAPI mode = GargPublicAPI
{ publicHomeAPI :: mode :- NamedRoutes HomeAPI
, publicNodeAPI :: mode :- NamedRoutes NodeAPI
} deriving Generic
data HomeAPI mode = HomeAPI
{ homeEp :: mode :- Summary "Public Home API" :> Get '[JSON] [Public.PublicData]
} deriving Generic
data NodeAPI mode = NodeAPI
{ nodeEp :: mode :- Summary "Public Node API" :> Capture "node" NodeId :> "file" :> NamedRoutes FileAPI
} deriving Generic
src/Gargantext/API/Routes/Named/Search.hs
View file @ 6240e820
......@@ -12,23 +12,16 @@ module Gargantext.API.Routes.Named.Search (
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.Core.Text.Corpus.Query (RawQuery (..))
import Gargantext.API.Search.Types ( SearchQuery(..), SearchType(..), SearchResult(..), SearchResultTypes(..) )
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Core.Types.Search
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Database.Query.Facet
import Prelude
import Servant
import Test.QuickCheck
-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
-- TODO-EVENTS: No event, this is a read-only query.
data SearchAPI results mode = SearchAPI
newtype SearchAPI results mode = SearchAPI
{ searchEp :: mode :- Summary "Search endpoint"
:> ReqBody '[JSON] SearchQuery
:> QueryParam "offset" Offset
......@@ -36,79 +29,3 @@ data SearchAPI results mode = SearchAPI
:> QueryParam "order" OrderBy
:> Post '[JSON] results
} deriving Generic
data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
deriving Generic
data SearchQuery = SearchQuery
{ query :: !RawQuery
, expected :: !SearchType
} deriving Generic
newtype SearchResult =
SearchResult { result :: SearchResultTypes }
deriving Generic
data SearchResultTypes =
SearchResultDoc { docs :: ![Row] }
| SearchResultContact { contacts :: ![Row] }
| SearchNoResult { message :: !Text }
deriving Generic
--
-- instances
--
instance FromJSON SearchResult where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchResult where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchResult
instance Arbitrary SearchResult where
arbitrary = SearchResult <$> arbitrary
instance FromJSON SearchResultTypes where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance ToJSON SearchResultTypes where
toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance Arbitrary SearchResultTypes where
arbitrary = do
srd <- SearchResultDoc <$> arbitrary
src <- SearchResultContact <$> arbitrary
srn <- pure $ SearchNoResult "No result because.."
elements [srd, src, srn]
instance ToSchema SearchResultTypes where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
instance FromJSON SearchQuery where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchQuery where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchQuery
instance Arbitrary SearchQuery where
arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
instance FromJSON SearchType where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchType where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema SearchType
instance Arbitrary SearchType where
arbitrary = elements [SearchDoc, SearchContact]
src/Gargantext/API/Routes/Named/Share.hs
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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 0 → 100644
View file @ 6240e820
module Gargantext.API.Search.Types where
import GHC.Generics
import Data.Aeson hiding (defaultTaggedObject)
import Data.Swagger hiding (fieldLabelModifier, Contact)
import Gargantext.Core.Text.Corpus.Query (RawQuery (..))
import Gargantext.Core.Types.Search
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Prelude
import Gargantext.Utils.Aeson (defaultTaggedObject)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-- | Main Types
-----------------------------------------------------------------------
data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
deriving (Generic)
instance FromJSON SearchType where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchType where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema SearchType
instance Arbitrary SearchType where
arbitrary = elements [SearchDoc, SearchContact]
-----------------------------------------------------------------------
data SearchQuery =
SearchQuery { query :: !RawQuery
, expected :: !SearchType
}
deriving (Generic)
instance FromJSON SearchQuery where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchQuery where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchQuery
{-
where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
instance Arbitrary SearchQuery where
arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
-- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
-----------------------------------------------------------------------
data SearchResult =
SearchResult { result :: !SearchResultTypes}
deriving (Generic)
instance FromJSON SearchResult where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchResult where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchResult
{-
where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
instance Arbitrary SearchResult where
arbitrary = SearchResult <$> arbitrary
data SearchResultTypes =
SearchResultDoc { docs :: ![Row] }
| SearchResultContact { contacts :: ![Row] }
| SearchNoResult { message :: !Text }
deriving (Generic)
instance FromJSON SearchResultTypes where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance ToJSON SearchResultTypes where
toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance Arbitrary SearchResultTypes where
arbitrary = do
srd <- SearchResultDoc <$> arbitrary
src <- SearchResultContact <$> arbitrary
srn <- pure $ SearchNoResult "No result because.."
elements [srd, src, srn]
instance ToSchema SearchResultTypes where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
--------------------------------------------------------------------
src/Gargantext/API/Server.hs → src/Gargantext/API/Server/Named.hs
View file @ 6240e820
{-|
Module : Gargantext.API.Server
Description : REST API declaration
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Server where
module Gargantext.API.Server.Named (
server
) where
import Control.Monad.Catch (catch, throwM)
import Data.ByteString.Lazy qualified as BL
......@@ -25,9 +17,9 @@ import Gargantext.API.Admin.FrontEnd (frontEndServer)
import Gargantext.API.Auth.PolicyCheck ()
import Gargantext.API.Errors
import Gargantext.API.GraphQL qualified as GraphQL
import Gargantext.API.Prelude (GargM, GargServer)
import Gargantext.API.Public qualified as Public
import Gargantext.API.Routes (API, GargVersion, GargAPI)
import Gargantext.API.Prelude (GargM)
import Gargantext.API.Server.Named.Public (serverPublicGargAPI)
import Gargantext.API.Routes.Named
import Gargantext.API.Swagger (swaggerDoc)
import Gargantext.API.ThrowAll (serverPrivateGargAPI)
import Gargantext.Database.Prelude (hasConfig)
......@@ -36,39 +28,40 @@ import Gargantext.Prelude.Config (gc_url_backend_api)
import Gargantext.System.Logging (logLocM, LogLevel(..))
import Paths_gargantext qualified as PG -- cabal magic build module
import Servant
import Servant.Server.Generic
import Servant.Swagger.UI (swaggerSchemaUIServer)
serverGargAPI :: Text -> ServerT GargAPI (GargM Env BackendInternalError)
serverGargAPI baseUrl -- orchestrator
= auth
:<|> forgotPassword
:<|> forgotPasswordAsync
:<|> gargVersion
:<|> serverPrivateGargAPI
:<|> Public.api baseUrl
-- :<|> orchestrator
serverGargAPI :: Text -> BackEndAPI (AsServerT (GargM Env BackendInternalError))
serverGargAPI baseUrl
= BackEndAPI $ MkBackEndAPI $ GargAPIVersion $ GargAPI'
{ gargAuthAPI = AuthAPI auth
, gargForgotPasswordAPI = forgotPassword
, gargForgotPasswordAsyncAPI = forgotPasswordAsync
, gargVersionAPI = gargVersion
, gargPrivateAPI = serverPrivateGargAPI
, gargPublicAPI = serverPublicGargAPI baseUrl
}
where
gargVersion :: GargServer GargVersion
gargVersion = pure (cs $ showVersion PG.version)
gargVersion :: GargVersion (AsServerT (GargM Env BackendInternalError))
gargVersion = GargVersion $ pure (cs $ showVersion PG.version)
-- | Server declarations
server :: Env -> IO (Server API)
server env = do
-- orchestrator <- scrapyOrchestrator env
pure $ \errScheme -> swaggerSchemaUIServer swaggerDoc
:<|> hoistServerWithContext
(Proxy :: Proxy GargAPI)
(Proxy :: Proxy AuthContext)
(transformJSON errScheme)
(serverGargAPI (env ^. hasConfig . gc_url_backend_api))
:<|> hoistServerWithContext
(Proxy :: Proxy GraphQL.API)
(Proxy :: Proxy AuthContext)
(transformJSONGQL errScheme)
GraphQL.api
:<|> frontEndServer
server :: Env -> API AsServer
server env =
API $ \errScheme -> NamedAPI
{ swaggerAPI = swaggerSchemaUIServer swaggerDoc
, backendAPI = hoistServerWithContext
(Proxy :: Proxy (NamedRoutes BackEndAPI))
(Proxy :: Proxy AuthContext)
(transformJSON errScheme)
(serverGargAPI (env ^. hasConfig . gc_url_backend_api))
, graphqlAPI = hoistServerWithContext
(Proxy :: Proxy GraphQL.API)
(Proxy :: Proxy AuthContext)
(transformJSONGQL errScheme)
GraphQL.api
, frontendAPI = frontEndServer
}
where
transformJSON :: forall a. GargErrorScheme -> GargM Env BackendInternalError a -> Handler a
transformJSON GES_old = Handler . withExceptT showAsServantJSONErr . (`runReaderT` env) . logPanicErrors
......
src/Gargantext/API/Server/Named/EKG.hs 0 → 100644
View file @ 6240e820
{-# 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 0 → 100644
View file @ 6240e820
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 0 → 100644
View file @ 6240e820
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
View file @ 6240e820
{-|
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 0 → 100644
View file @ 6240e820
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
View file @ 6240e820
......@@ -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 0 → 100644
View file @ 6240e820
{-# 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
View file @ 6240e820
......@@ -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 0 → 100644
View file @ 6240e820
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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
View file @ 6240e820
......@@ -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
......
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