Commit 2b67dad8 authored by Alexandre Delanoë's avatar Alexandre Delanoë

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

parents 0a4a4d95 406b3e58
......@@ -24,7 +24,8 @@ import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Prelude
import Gargantext.Prelude.Config (readConfig)
import Prelude (read)
import qualified Gargantext.API.Node.Share as Share
import Gargantext.API.Node.Share.Types qualified as Share
import Gargantext.API.Node.Share qualified as Share
main :: IO ()
main = do
......
......@@ -18,8 +18,8 @@ fi
# with the `sha256sum` result calculated on the `cabal.project` and
# `cabal.project.freeze`. This ensures the files stay deterministic so that CI
# cache can kick in.
expected_cabal_project_hash="0d3f7f5beed88c1afe95e0df8a91080440ba59049f3610bf2343132635038d22"
expected_cabal_project_freeze_hash="9b2cac3a02e9b129bd80253fc407782bf10c7ed62ed21be41c720d30ed17ef53"
expected_cabal_project_hash="75954432d1b867597b6eff606d22b36e53a18b283464c9c9d309af231a694d6b"
expected_cabal_project_freeze_hash="09930a2fa36e4325d46e5d069595d300c6017472f405f8ac67158377816d132a"
cabal --store-dir=$STORE_DIR v2-build --dry-run
cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
......
......@@ -51,8 +51,8 @@ source-repository-package
source-repository-package
type: git
location: https://github.com/alpmestan/servant-job.git
tag: b4182487cfe479777c11ca19f3c0d47840b376f6
location: https://github.com/adinapoli/servant-job.git
tag: 74a3296dfe1f0c4a3ade91336dcc689330e84156
source-repository-package
type: git
......
......@@ -499,7 +499,7 @@ constraints: any.Cabal ==3.8.1.0,
any.servant-multipart ==0.12.1,
any.servant-multipart-api ==0.12.1,
any.servant-server ==0.20,
any.servant-swagger ==1.1.11,
any.servant-swagger ==1.2,
any.servant-swagger-ui ==0.3.5.5.0.0,
any.servant-swagger-ui-core ==0.3.5,
any.servant-xml-conduit ==0.1.0.4,
......
......@@ -113,6 +113,7 @@ library
Gargantext.API.Admin.Settings.CORS
Gargantext.API.Admin.Types
Gargantext.API.Auth.PolicyCheck
Gargantext.API.Count.Types
Gargantext.API.Dev
Gargantext.API.Errors
Gargantext.API.Errors.Class
......@@ -132,18 +133,23 @@ library
Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.Corpus.Update
Gargantext.API.Node.File
Gargantext.API.Node.File.Types
Gargantext.API.Node.Share
Gargantext.API.Node.Share.Types
Gargantext.API.Node.ShareURL
Gargantext.API.Node.Types
Gargantext.API.Node.Update
Gargantext.API.Node.Update.Types
Gargantext.API.Prelude
Gargantext.API.Routes
Gargantext.API.Routes.Named
Gargantext.API.Routes.Named.Annuaire
Gargantext.API.Routes.Named.Contact
Gargantext.API.Routes.Named.Context
Gargantext.API.Routes.Named.Corpus
Gargantext.API.Routes.Named.Count
Gargantext.API.Routes.Named.Document
Gargantext.API.Routes.Named.EKG
Gargantext.API.Routes.Named.File
Gargantext.API.Routes.Named.FrameCalc
Gargantext.API.Routes.Named.List
......@@ -157,6 +163,8 @@ library
Gargantext.API.Routes.Named.Tree
Gargantext.API.Routes.Named.Viz
Gargantext.API.Routes.Types
Gargantext.API.Types
Gargantext.API.Viz.Types
Gargantext.Core
Gargantext.Core.Mail.Types
Gargantext.Core.Methods.Similarities
......@@ -288,6 +296,7 @@ library
Gargantext.API.Metrics
Gargantext.API.Ngrams.NgramsTree
Gargantext.API.Node.Contact
Gargantext.API.Node.Contact.Types
Gargantext.API.Node.Corpus.Annuaire
Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export.Types
......@@ -299,17 +308,27 @@ library
Gargantext.API.Node.Phylo.Export
Gargantext.API.Node.Phylo.Export.Types
Gargantext.API.Node.DocumentUpload
Gargantext.API.Node.DocumentUpload.Types
Gargantext.API.Node.DocumentsFromWriteNodes
Gargantext.API.Node.DocumentsFromWriteNodes.Types
Gargantext.API.Node.FrameCalcUpload
Gargantext.API.Node.FrameCalcUpload.Types
Gargantext.API.Node.Get
Gargantext.API.Node.New
Gargantext.API.Public
Gargantext.API.Node.New.Types
Gargantext.API.Public.Types
Gargantext.API.Search
Gargantext.API.Server
Gargantext.API.Search.Types
Gargantext.API.Server.Named
Gargantext.API.Server.Named.EKG
Gargantext.API.Server.Named.Ngrams
Gargantext.API.Server.Named.Private
Gargantext.API.Server.Named.Public
Gargantext.API.Server.Named.Viz
Gargantext.API.Swagger
Gargantext.API.Table
Gargantext.API.Table.Types
Gargantext.API.ThrowAll
Gargantext.API.Types
Gargantext.Core.Ext.IMT
Gargantext.Core.Ext.IMTUser
Gargantext.Core.Flow.Ngrams
......@@ -622,8 +641,9 @@ library
, servant-job >= 0.2.0.0
, servant-multipart ^>= 0.12.1
, servant-server >= 0.18.3 && < 0.20
, servant-swagger ^>= 1.1.10
, servant-swagger >= 1.2
, servant-swagger-ui ^>= 0.3.5.3.5.0
, servant-swagger-ui-core >= 0.3.5
, servant-xml-conduit >= 0.1.0.4
, simple-reflect ^>= 0.3.3
, singletons ^>= 2.7
......
......@@ -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
......@@ -27,41 +27,42 @@ And you have the main viz
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
module Gargantext.API.Admin.Auth
( auth
, withPolicy
, withPolicyT
, withNamedPolicyT
, forgotPassword
, forgotPasswordAsync
, withAccess
, ForgotPasswordAPI
, withNamedAccess
, ForgotPasswordAsyncParams
, ForgotPasswordAsyncAPI
)
where
import Control.Lens (view, (#))
import Data.Aeson
import Data.Swagger (ToSchema(..))
import Data.Text qualified as Text
import Data.Text.Lazy.Encoding qualified as LE
import Data.UUID (UUID, fromText, toText)
import Data.UUID.V4 (nextRandom)
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Admin.Types
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, GargServer, _ServerError, GargM)
import Gargantext.API.Errors
import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, _ServerError, GargM, IsGargServer)
import Gargantext.Core.Mail (MailModel(..), mail)
import Gargantext.Core.Mail.Types (mailSettings)
import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Action.User.New (guessUserName)
import Gargantext.Database.Admin.Types.Node (NodeId(..))
import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
import Gargantext.Database.Admin.Types.Node (UserId)
import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
import Gargantext.Database.Query.Table.User
import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
import Gargantext.Database.Query.Tree.Root (getRoot)
......@@ -71,8 +72,10 @@ import Gargantext.Prelude.Crypto.Auth qualified as Auth
import Gargantext.Prelude.Crypto.Pass.User (gargPass)
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant
import Servant.API.Generic ()
import Servant.Auth.Server
import Gargantext.API.Errors
import Servant.Server.Generic
import qualified Gargantext.API.Routes.Named as Named
---------------------------------------------------
......@@ -163,10 +166,23 @@ withAccess p _ ur id = hoistServer p f
f :: forall a. m a -> m a
f = withAccessM ur id
withNamedAccess :: forall env err m routes.
( IsGargServer env err m
, HasServer (NamedRoutes routes) '[]
)
=> AuthenticatedUser
-> PathId
-> routes (AsServerT m)
-> routes (AsServerT m)
withNamedAccess ur pathId = hoistServer (Proxy @(NamedRoutes routes)) f
where
f :: forall a. m a -> m a
f = withAccessM ur pathId
-- | Given the 'AuthenticatedUser', a policy check and a function that returns an @a@,
-- it runs the underlying policy check to ensure that the resource is returned only to
-- who is entitled to see it.
withPolicy :: GargServerC env BackendInternalError m
withPolicy :: IsGargServer env BackendInternalError m
=> AuthenticatedUser
-> BoolExpr AccessCheck
-> m a
......@@ -179,8 +195,21 @@ withPolicy ur checks m mgr = case mgr of
Allow -> m
Deny err -> throwError $ InternalServerError $ err
-- FIXME(adn) the types are wrong.
withNamedPolicyT :: forall env m routes.
( IsGargServer env BackendInternalError m
, HasServer (NamedRoutes routes) '[]
)
=> AuthenticatedUser
-> BoolExpr AccessCheck
-> routes (AsServerT m)
-> AccessPolicyManager
-> routes (AsServerT m)
withNamedPolicyT ur checks m mgr =
hoistServer (Proxy @(NamedRoutes routes)) (\n -> withPolicy ur checks n mgr) m
withPolicyT :: forall env m api. (
GargServerC env BackendInternalError m
IsGargServer env BackendInternalError m
, HasServer api '[]
)
=> Proxy api
......@@ -202,26 +231,12 @@ User can invite User in Team as NodeNode only if Team in his parents.
All users can access to the Team folder as if they were owner.
-}
newtype ForgotPasswordAsyncParams =
ForgotPasswordAsyncParams { email :: Text }
deriving (Generic, Show)
instance FromJSON ForgotPasswordAsyncParams where
parseJSON = genericParseJSON defaultOptions
instance ToJSON ForgotPasswordAsyncParams where
toJSON = genericToJSON defaultOptions
instance ToSchema ForgotPasswordAsyncParams
type ForgotPasswordAPI = Summary "Forgot password POST API"
:> ReqBody '[JSON] ForgotPasswordRequest
:> Post '[JSON] ForgotPasswordResponse
:<|> Summary "Forgot password GET API"
:> QueryParam "uuid" Text
:> Get '[JSON] ForgotPasswordGet
forgotPassword :: GargServer ForgotPasswordAPI
forgotPassword :: IsGargServer env err m => Named.ForgotPasswordAPI (AsServerT m)
-- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
forgotPassword = forgotPasswordPost :<|> forgotPasswordGet
forgotPassword = Named.ForgotPasswordAPI
{ forgotPasswordPostEp = forgotPasswordPost
, forgotPasswordGetEp = forgotPasswordGet
}
forgotPasswordPost :: (CmdCommon env)
=> ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
......@@ -310,11 +325,8 @@ generateForgotPasswordUUID = do
-- NOTE THe async endpoint is better for the "forget password"
-- request, because the delay in email sending etc won't reveal to
-- malicious users emails of our users in the db
type ForgotPasswordAsyncAPI = Summary "Forgot password asnc"
:> AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog
forgotPasswordAsync :: ServerT ForgotPasswordAsyncAPI (GargM Env BackendInternalError)
forgotPasswordAsync =
forgotPasswordAsync :: Named.ForgotPasswordAsyncAPI (AsServerT (GargM Env BackendInternalError))
forgotPasswordAsync = Named.ForgotPasswordAsyncAPI $ AsyncJobs $
serveJobsAPI ForgotPasswordJob $ \jHandle p -> forgotPasswordAsync' p jHandle
forgotPasswordAsync' :: (FlowCmdM env err m, MonadJobStatus m)
......
......@@ -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
--
......
......@@ -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)
......@@ -136,5 +136,6 @@ type ScrapersEnv = JobEnv JobLog JobLog
type ScraperAPI = AsyncJobsAPI JobLog ScraperInput JobLog
------------------------------------------------------------------------
type AsyncJobs event ctI input output =
AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output
data AsyncJobs event ctI input output mode = AsyncJobs
{ asyncJobsAPI' :: mode :- AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output }
deriving Generic
......@@ -39,6 +39,7 @@ import Servant.Ekg
import Servant.Server.Internal.Delayed
import Servant.Server.Internal.DelayedIO
import qualified Servant.Swagger as Swagger
import Servant.Client.Core
-------------------------------------------------------------------------------
-- Types
......@@ -196,6 +197,12 @@ instance HasEndpoint sub => HasEndpoint (PolicyChecked sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
instance HasClient m sub => HasClient m (PolicyChecked sub) where
type Client m (PolicyChecked sub) = AccessPolicyManager -> Client m sub
clientWithRoute m _ req _mgr = clientWithRoute m (Proxy :: Proxy sub) req
hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
-------------------------------------------------------------------------------
-- Utility functions
-------------------------------------------------------------------------------
......
......@@ -23,28 +23,27 @@ import Prelude
import Data.Aeson (FromJSON, ToJSON)
import Servant
import Gargantext.API.Admin.Auth (withAccess)
import Gargantext.API.Admin.Auth (withNamedAccess)
import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser)
import Gargantext.API.Prelude
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (JSONB)
import Gargantext.Database.Query.Table.Context
import Servant.Server.Generic (AsServerT)
import Gargantext.API.Routes.Named.Context qualified as Named
-------------------------------------------------------------------
-- TODO use Context instead of Node
type ContextAPI a = Get '[JSON] (Node a)
------------------------------------------------------------------------
-- TODO NodeAPI -> ContextAPI
contextAPI :: forall proxy a.
( JSONB a
, FromJSON a
, ToJSON a
) => proxy a
-> AuthenticatedUser
-> ContextId
-> GargServer (ContextAPI a)
contextAPI p uId id' = withAccess (Proxy :: Proxy (ContextAPI a)) Proxy uId (PathNode $ contextId2NodeId id') contextAPI'
contextAPI :: ( IsGargServer env err m
, JSONB a
, FromJSON a
, ToJSON a )
=> Proxy a
-> AuthenticatedUser
-> ContextId
-> Named.ContextAPI a (AsServerT m)
contextAPI p uId id' =
withNamedAccess uId (PathNode $ contextId2NodeId id') contextAPI'
where
contextAPI' :: GargServer (ContextAPI a)
contextAPI' = getContextWith id' p
contextAPI' = Named.ContextAPI $ getContextWith id' p
......@@ -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
{-# 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
......@@ -10,23 +10,18 @@ Portability : POSIX
module Gargantext.API.Members where
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors.Types
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Private qualified as Named
import Gargantext.Database.Action.Share (membersOf)
import Gargantext.Database.Admin.Types.Node (NodeType(NodeTeam))
import Gargantext.Database.Prelude (CmdCommon)
import Gargantext.Database.Query.Table.Node (getNodesIdWithType)
import Gargantext.Prelude
import Servant
import Servant.Server.Generic (AsServerT)
type MembersAPI = Get '[JSON] [Text]
members :: IsGargServer err env m => Named.MembersAPI (AsServerT m)
members = Named.MembersAPI getMembers
members :: ServerT MembersAPI (GargM Env BackendInternalError)
members = getMembers
getMembers :: (CmdCommon env) =>
GargM env BackendInternalError [Text]
getMembers :: IsGargServer err env m => m [Text]
getMembers = do
teamNodeIds <- getNodesIdWithType NodeTeam
m <- concatMapM membersOf teamNodeIds
......
......@@ -25,7 +25,8 @@ import Data.Vector (Vector)
import Gargantext.API.HashedResponse
import Gargantext.API.Ngrams.NgramsTree
import Gargantext.API.Ngrams.Types
import Gargantext.API.Prelude (GargServer)
import Gargantext.API.Prelude (IsGargServer)
import Gargantext.API.Routes.Named.Metrics qualified as Named
import Gargantext.Core.NodeStory (HasNodeStory)
import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
import Gargantext.Core.Types (CorpusId, ListId, ListType(..))
......@@ -43,28 +44,15 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude hiding (hash)
import Servant
import Servant.Server.Generic (AsServerT)
-------------------------------------------------------------
-- | Scatter metrics API
type ScatterAPI = Summary "SepGen IncExc metrics"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Limit
:> Get '[JSON] (HashedResponse Metrics)
:<|> Summary "Scatter update"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Limit
:> Post '[JSON] ()
:<|> "hash" :> Summary "Scatter Hash"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] Text
scatterApi :: NodeId -> GargServer ScatterAPI
scatterApi id' = getScatter id'
:<|> updateScatter id'
:<|> getScatterHash id'
scatterApi :: IsGargServer err env m => NodeId -> Named.ScatterAPI (AsServerT m)
scatterApi id' = Named.ScatterAPI
{ sepGenEp = getScatter id'
, scatterUpdateEp = updateScatter id'
, scatterHashEp = getScatterHash id'
}
getScatter :: HasNodeStory env err m
=> CorpusId
......@@ -139,27 +127,12 @@ getScatterHash cId maybeListId tabType = do
-------------------------------------------------------------
-- | Chart metrics API
type ChartApi = Summary " Chart API"
:> QueryParam "from" UTCTime
:> QueryParam "to" UTCTime
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] (HashedResponse (ChartMetrics Histo))
:<|> Summary "Chart update"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Limit
:> Post '[JSON] ()
:<|> "hash" :> Summary "Chart Hash"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] Text
chartApi :: NodeId -> GargServer ChartApi
chartApi id' = getChart id'
:<|> updateChart id'
:<|> getChartHash id'
chartApi :: IsGargServer err env m => NodeId -> Named.ChartAPI (AsServerT m)
chartApi id' = Named.ChartAPI
{ getChartEp = getChart id'
, updateChartEp = updateChart id'
, chartHashEp = getChartHash id'
}
-- TODO add start / end
getChart :: HasNodeStory env err m
......@@ -243,10 +216,12 @@ type PieApi = Summary "Pie Chart"
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] Text
pieApi :: NodeId -> GargServer PieApi
pieApi id' = getPie id'
:<|> updatePie id'
:<|> getPieHash id'
pieApi :: IsGargServer err env m => NodeId -> Named.PieAPI (AsServerT m)
pieApi id' = Named.PieAPI
{ getPieChartEp = getPie id'
, pieChartUpdateEp = updatePie id'
, pieHashEp = getPieHash id'
}
getPie :: HasNodeStory env err m
=> CorpusId
......@@ -313,29 +288,12 @@ getPieHash cId maybeListId tabType = do
-------------------------------------------------------------
-- | Tree metrics API
type TreeApi = Summary " Tree API"
:> QueryParam "from" UTCTime
:> QueryParam "to" UTCTime
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
:> Get '[JSON] (HashedResponse (ChartMetrics (Vector NgramsTree)))
:<|> Summary "Tree Chart update"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
:> Post '[JSON] ()
:<|> "hash" :>
Summary "Tree Hash"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
:> Get '[JSON] Text
treeApi :: NodeId -> GargServer TreeApi
treeApi id' = getTree id'
:<|> updateTree id'
:<|> getTreeHash id'
treeApi :: IsGargServer err env m => NodeId -> Named.TreeAPI (AsServerT m)
treeApi id' = Named.TreeAPI
{ treeChartEp = getTree id'
, treeChartUpdateEp = updateTree id'
, treeHashEp = getTreeHash id'
}
getTree :: HasNodeStory env err m
=> CorpusId
......
This diff is collapsed.
......@@ -28,14 +28,14 @@ import Data.Text (concat, pack, splitOn)
import Data.Vector (Vector)
import Data.Vector qualified as Vec
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types ( AsyncJobs, JobLog )
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.API.Ngrams (setListNgrams)
import Gargantext.API.Ngrams.List.Types
import Gargantext.API.Ngrams.Prelude (getNgramsList)
import Gargantext.API.Ngrams.Types
import Gargantext.API.Prelude (GargServer, GargM, serverError, HasServerError)
import Gargantext.API.Types (HTML)
import Gargantext.API.Prelude (GargM, serverError, HasServerError)
import Gargantext.API.Routes.Named.List qualified as Named
import Gargantext.Core.NodeStory.Types ( HasNodeStory )
import Gargantext.Core.Text.Ngrams (Ngrams, NgramsType(NgramsTerms))
import Gargantext.Core.Types.Main (ListType(..))
......@@ -47,41 +47,25 @@ import Gargantext.Database.Schema.Node (_node_parent_id)
import Gargantext.Database.Types (Indexed(..))
import Gargantext.Prelude hiding (concat, toList)
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Gargantext.Utils.Servant qualified as GUS
import Prelude qualified
import Protolude qualified as P
import Servant
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
type GETAPI = Summary "Get List"
:> "lists"
:> Capture "listId" ListId
:> ( "json"
:> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
:<|> "json.zip"
:> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
:<|> "csv"
:> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap) )
getApi :: GargServer GETAPI
getApi listId = getJson listId
:<|> getJsonZip listId
:<|> getCsv listId
getAPI :: Named.GETAPI (AsServerT (GargM Env BackendInternalError))
getAPI = Named.GETAPI $ \listId -> Named.ListEndpoints
{ listJSONEp = getJson listId
, listJSONZipEp = getJsonZip listId
, listCSVEp = getCsv listId
}
--
-- JSON API
--
----------------------
type JSONAPI = Summary "Update List"
:> "lists"
:> Capture "listId" ListId
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog
jsonApi :: ServerT JSONAPI (GargM Env BackendInternalError)
jsonApi = jsonPostAsync
jsonAPI :: Named.JSONAPI (AsServerT (GargM Env BackendInternalError))
jsonAPI = jsonPostAsync
------------------------------------------------------------------------
getJson :: HasNodeStory env err m
......@@ -122,8 +106,8 @@ getCsv lId = do
) _v_data
------------------------------------------------------------------------
jsonPostAsync :: ServerT JSONAPI (GargM Env BackendInternalError)
jsonPostAsync lId =
jsonPostAsync :: Named.JSONAPI (AsServerT (GargM Env BackendInternalError))
jsonPostAsync = Named.JSONAPI $ \lId -> AsyncJobs $
serveJobsAPI UpdateNgramsListJobJSON $ \jHandle f ->
postAsyncJSON lId (_wjf_data f) jHandle
......@@ -159,22 +143,12 @@ postAsyncJSON l ngramsList jobHandle = do
-- CSV API
--
----------------------
type CSVAPI = Summary "Update List (legacy v3 CSV)"
:> "lists"
:> Capture "listId" ListId
:> "csv"
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog
csvApi :: ServerT CSVAPI (GargM Env BackendInternalError)
csvApi = csvPostAsync
csvAPI :: Named.CSVAPI (AsServerT (GargM Env BackendInternalError))
csvAPI = csvPostAsync
------------------------------------------------------------------------
csvPostAsync :: ServerT CSVAPI (GargM Env BackendInternalError)
csvPostAsync lId =
csvPostAsync :: Named.CSVAPI (AsServerT (GargM Env BackendInternalError))
csvPostAsync = Named.CSVAPI $ \lId -> AsyncJobs $
serveJobsAPI UpdateNgramsListJobCSV $ \jHandle f -> do
case ngramsListFromCSVData (_wtf_data f) of
Left err -> serverError $ err500 { errReasonPhrase = err }
......
......@@ -49,7 +49,7 @@ import Gargantext.Prelude hiding (IsString, hash, from, replace, to)
import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
import Gargantext.Utils.Servant (CSV, ZIP)
import Gargantext.Utils.Zip (zipContentsPure)
import Servant ( FromHttpApiData(parseUrlPiece), ToHttpApiData(toUrlPiece), Required, Strict, QueryParam', MimeRender(.. ))
import Servant ( FromHttpApiData(parseUrlPiece), ToHttpApiData(toUrlPiece), Required, Strict, QueryParam', MimeRender(.. ), MimeUnrender(..))
import Servant.Job.Utils (jsonOptions)
import Test.QuickCheck (elements, frequency)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
......@@ -94,7 +94,7 @@ instance ToJSONKey TabType where
toJSONKey = genericToJSONKey defaultJSONKeyOptions
newtype MSet a = MSet (Map a ())
deriving stock (Eq, Ord, Show, Generic)
deriving stock (Eq, Ord, Show, Read, Generic)
deriving newtype (Arbitrary, Semigroup, Monoid)
deriving anyclass (ToExpr)
......@@ -128,7 +128,7 @@ instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
------------------------------------------------------------------------
newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text }
deriving (Ord, Eq, Show, Generic)
deriving (Ord, Eq, Show, Read, Generic)
deriving newtype (ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable, NFData, FromField, ToField)
deriving anyclass (ToExpr)
instance IsHashable NgramsTerm where
......@@ -159,7 +159,7 @@ data NgramsRepoElement = NgramsRepoElement
, _nre_parent :: !(Maybe NgramsTerm)
, _nre_children :: !(MSet NgramsTerm)
}
deriving (Ord, Eq, Show, Generic)
deriving (Ord, Eq, Show, Read, Generic)
deriveJSON (unPrefix "_nre_") ''NgramsRepoElement
-- TODO
-- if ngrams & not size => size
......@@ -811,6 +811,9 @@ instance MimeRender ZIP NgramsListZIP where
mimeRender _ nlz@(NgramsListZIP { .. }) =
zipContentsPure (T.unpack $ nlzFileName nlz) (encode _nlz_nl)
instance MimeUnrender ZIP NgramsListZIP where
mimeUnrender _ _ = Left "mimeUnrender for NgramsListZIP not supported"
--
......
This diff is collapsed.
......@@ -21,15 +21,15 @@ module Gargantext.API.Node.Contact
where
import Conduit ( yield )
import Data.Aeson
import Data.Swagger ( ToSchema )
import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(AuthenticatedUser) )
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node ( nodeNodeAPI, NodeNodeAPI )
import Gargantext.API.Node ( nodeNodeAPI )
import Gargantext.API.Node.Contact.Types
import Gargantext.API.Prelude (GargM, simuLogs)
import Gargantext.API.Routes.Named.Contact qualified as Named
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Types.Individu (User(..))
......@@ -38,38 +38,21 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact, hyperdataContact )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire(..) )
import Gargantext.Database.Admin.Types.Node ( CorpusId, NodeId )
import Gargantext.Prelude (($), Generic, Maybe(..), Text)
import Gargantext.Utils.Aeson qualified as GUA
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
import Gargantext.Prelude (($), Maybe(..))
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
------------------------------------------------------------------------
type API = "contact" :> Summary "Contact endpoint"
:> API_Async
:<|> Capture "contact_id" NodeId
:> NodeNodeAPI HyperdataContact
import Servant.Server.Generic (AsServerT)
api :: AuthenticatedUser -> CorpusId -> ServerT API (GargM Env BackendInternalError)
api authUser@(AuthenticatedUser userNodeId _userUserId) cid =
(api_async (RootId userNodeId) cid)
:<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) authUser cid)
type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
------------------------------------------------------------------------
data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
| AddContactParamsAdvanced { firstname :: !Text
, lastname :: !Text
-- TODO add others fields
}
deriving (Generic)
contactAPI :: AuthenticatedUser -> CorpusId -> Named.ContactAPI (AsServerT (GargM Env BackendInternalError))
contactAPI authUser@(AuthenticatedUser userNodeId _userUserId) cid = Named.ContactAPI
{ contactAsyncAPI = api_async (RootId userNodeId) cid
, getContactEp = nodeNodeAPI (Proxy :: Proxy HyperdataContact) authUser cid
}
----------------------------------------------------------------------
api_async :: User -> NodeId -> ServerT API_Async (GargM Env BackendInternalError)
api_async u nId =
api_async :: User -> NodeId -> Named.ContactAsyncAPI (AsServerT (GargM Env BackendInternalError))
api_async u nId = Named.ContactAsyncAPI $ AsyncJobs $
serveJobsAPI AddContactJob $ \jHandle p ->
addContact u nId p jHandle
......@@ -88,16 +71,3 @@ addContact u nId (AddContactParams fn ln) jobHandle = do
addContact _uId _nId _p jobHandle = do
simuLogs jobHandle 10
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON AddContactParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON AddContactParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema AddContactParams
instance Arbitrary AddContactParams where
arbitrary = elements [AddContactParams "Pierre" "Dupont"]
------------------------------------------------------------------------
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"]
------------------------------------------------------------------------
......@@ -17,7 +17,6 @@ module Gargantext.API.Node.Corpus.Annuaire
import Control.Lens hiding (elements)
import Data.Aeson
import Data.Swagger
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Corpus.New.Types qualified as NewTypes
import Gargantext.Core (Lang(..))
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
......@@ -51,16 +50,6 @@ instance ToJSON AnnuaireWithForm where
instance ToSchema AnnuaireWithForm where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
------------------------------------------------------------------------
type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint"
:> "annuaire"
:> Capture "annuaire_id" AnnuaireId
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog
------------------------------------------------------------------------
addToAnnuaireWithForm :: (FlowCmdM env err m, MonadJobStatus m)
=> AnnuaireId
......
......@@ -26,7 +26,7 @@ import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo
import Gargantext.API.Ngrams.Types ( NgramsTerm(unNgramsTerm) )
import Gargantext.API.Node.Corpus.Export.Types ( Corpus(..) )
import Gargantext.API.Node.Document.Export.Types qualified as DocumentExport
import Gargantext.API.Prelude (GargNoServer)
import Gargantext.API.Prelude (IsGargServer)
import Gargantext.Core.NodeStory.Types ( NodeListStory )
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Types.Main ( ListType(MapTerm) )
......@@ -42,52 +42,52 @@ import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
import Gargantext.Database.Schema.Context (_context_id)
import Gargantext.Prelude hiding (hash)
import Gargantext.Prelude.Crypto.Hash (hash)
import Servant (Headers, Header, addHeader, Summary, (:>), JSON, Get, QueryParam)
--------------------------------------------------
type API = Summary "Corpus Export"
:> "export"
:> QueryParam "listId" ListId
:> QueryParam "ngramsType" NgramsType
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Corpus)
import Servant (Headers, Header, addHeader)
import Servant.Server.Generic (AsServerT)
import qualified Gargantext.API.Routes.Named.Corpus as Named
--------------------------------------------------
-- | Hashes are ordered by Set
getCorpus :: CorpusId
-> Maybe ListId
-> Maybe NgramsType
-> GargNoServer (Headers '[Header "Content-Disposition" Text] Corpus)
getCorpus cId lId nt' = do
getCorpus :: forall env err m. IsGargServer env err m
=> CorpusId
-> Named.CorpusExportAPI (AsServerT m)
getCorpus cId = Named.CorpusExportAPI $ \lId nt' -> get_corpus lId nt'
let
nt = fromMaybe NgramsTerms nt'
where
get_corpus :: IsGargServer env err m
=> Maybe ListId
-> Maybe NgramsType
-> m (Headers '[Header "Content-Disposition" Text] Corpus)
get_corpus lId nt' = do
let
nt = fromMaybe NgramsTerms nt'
listId <- case lId of
Nothing -> defaultList cId
Just l -> pure l
listId <- case lId of
Nothing -> defaultList cId
Just l -> pure l
-- FIXME(adn) Audit the usage of this, we are converting from a node
-- to a context id.
ns <- Map.fromList
<$> map (\n -> (nodeId2ContextId $ _context_id n, n))
<$> selectDocNodes cId
-- FIXME(adn) Audit the usage of this, we are converting from a node
-- to a context id.
ns <- Map.fromList
<$> map (\n -> (nodeId2ContextId $ _context_id n, n))
<$> selectDocNodes cId
repo <- getRepo [listId]
ngs <- getContextNgrams cId listId MapTerm nt repo
let -- uniqId is hash computed already for each document imported in database
r = Map.intersectionWith
(\a b -> DocumentExport.Document { _d_document = context2node a
, _d_ngrams = DocumentExport.Ngrams (Set.toList b) (hash b)
, _d_hash = d_hash a b }
) ns (Map.map (Set.map unNgramsTerm) ngs)
where
d_hash :: Context HyperdataDocument -> Set Text -> Text
d_hash _a b = hash [ -- fromMaybe "" (_hd_uniqId $ _context_hyperdata a),
hash b
]
pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".json")
$ Corpus { _c_corpus = Map.elems r
, _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
repo <- getRepo [listId]
ngs <- getContextNgrams cId listId MapTerm nt repo
let -- uniqId is hash computed already for each document imported in database
r = Map.intersectionWith
(\a b -> DocumentExport.Document { _d_document = context2node a
, _d_ngrams = DocumentExport.Ngrams (Set.toList b) (hash b)
, _d_hash = d_hash a b }
) ns (Map.map (Set.map unNgramsTerm) ngs)
where
d_hash :: Context HyperdataDocument -> Set Text -> Text
d_hash _a b = hash [ -- fromMaybe "" (_hd_uniqId $ _context_hyperdata a),
hash b
]
pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".json")
$ Corpus { _c_corpus = Map.elems r
, _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
getContextNgrams :: HasNodeError err
=> CorpusId
......
......@@ -28,7 +28,6 @@ import Data.Swagger ( ToSchema(..) )
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import EPO.API.Client.Types qualified as EPO
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
import Gargantext.API.Node.Corpus.New.Types ( FileFormat(..), FileType(..) )
......@@ -61,7 +60,6 @@ import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_max_docs_parsers)
import Gargantext.System.Logging ( logLocM, LogLevel(..) )
import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(..))
import Servant ( JSON, type (:>), FormUrlEncoded, Capture, Summary )
import Test.QuickCheck.Arbitrary (Arbitrary(..))
------------------------------------------------------------------------
......@@ -132,13 +130,6 @@ instance ToSchema ApiInfo
info :: ApiInfo
info = ApiInfo API.externalAPIs
------------------------------------------------------------------------
type AddWithQuery = Summary "Add with Query to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "query"
:> AsyncJobs JobLog '[JSON] WithQuery JobLog
{-
type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
:> "corpus"
......@@ -228,14 +219,6 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
$(logLocM) ERROR (T.pack $ show err) -- log the full error
markFailed (Just err) jobHandle
type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
addToCorpusWithForm :: ( FlowCmdM env err m
, MonadJobStatus m
, HasNodeStoryImmediateSaver env
......@@ -342,16 +325,6 @@ addToCorpusWithFile cid input filetype logStatus = do
}
-}
type AddWithFile = Summary "Add with FileUrlEncoded to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "add"
:> "file"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
addToCorpusWithFile :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
=> User
-> CorpusId
......
......@@ -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
......
......@@ -27,7 +27,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..))
import Gargantext.Utils.Servant (ZIP)
import Gargantext.Utils.Zip (zipContentsPureWithLastModified)
import Protolude
import Servant ((:>), (:<|>), Get, Header, Headers(..), JSON, MimeRender(..), PlainText, Summary)
import Servant (MimeRender(..), MimeUnrender(..))
-- | Document Export
......@@ -101,15 +101,6 @@ instance ToParamSchema Document where
instance ToParamSchema Ngrams where
toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
--------------------------------------------------
type API = Summary "Document Export"
:> "export"
:> ( "json"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
:<|> "json.zip"
:> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
:<|> "csv"
:> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text) )
$(deriveJSON (unPrefix "_ng_") ''Ngrams)
$(deriveJSON (unPrefix "_d_") ''Document)
......@@ -127,3 +118,6 @@ dezFileName (DocumentExportZIP { .. }) = "GarganText_DocsList-" <> show _dez_doc
instance MimeRender ZIP DocumentExportZIP where
mimeRender _ dexpz@(DocumentExportZIP { .. }) =
zipContentsPureWithLastModified (T.unpack $ dezFileName dexpz) (encode _dez_dexp) _dez_last_modified
instance MimeUnrender ZIP DocumentExportZIP where
mimeUnrender _ _ = Left "mimeUnrender for DocumentExportZIP not supported"
......@@ -17,18 +17,17 @@ Portability : POSIX
module Gargantext.API.Node.DocumentUpload where
import Control.Lens (view)
import Data.Aeson ( Options(..), genericParseJSON, defaultOptions, genericToJSON, SumEncoding(..) )
import Data.Swagger (ToSchema)
import Data.Text qualified as T
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node.DocumentUpload.Types
import Gargantext.API.Prelude ( GargM )
import Gargantext.API.Routes.Named.Document qualified as Named
import Gargantext.Core (Lang(..))
import Gargantext.Core.NLP (nlpServerGet)
import Gargantext.Core.Text.Corpus.Parsers.Date (mDateSplit)
import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus)
import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataCorpus )
......@@ -37,47 +36,11 @@ import Gargantext.Database.Admin.Types.Node ( DocId, NodeId, NodeType(NodeCorpus
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant ( JSON, Summary, type (:>), HasServer(ServerT) )
import Servant.Server.Generic (AsServerT)
data DocumentUpload = DocumentUpload
{ _du_abstract :: T.Text
, _du_authors :: T.Text
, _du_sources :: T.Text
, _du_title :: T.Text
, _du_date :: T.Text
, _du_language :: T.Text
}
deriving (Generic)
$(makeLenses ''DocumentUpload)
instance ToSchema DocumentUpload
instance FromJSON DocumentUpload
where
parseJSON = genericParseJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
instance ToJSON DocumentUpload
where
toJSON = genericToJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
type API = Summary " Document upload"
:> "document"
:> "upload"
:> "async"
:> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
api :: NodeId -> ServerT API (GargM Env BackendInternalError)
api nId =
api :: NodeId -> Named.DocumentUploadAPI (AsServerT (GargM Env BackendInternalError))
api nId = Named.DocumentUploadAPI $ AsyncJobs $
serveJobsAPI UploadDocumentJob $ \jHandle q -> do
documentUploadAsync nId q jHandle
......
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Node.DocumentUpload.Types where
import Data.Aeson ( Options(..), genericParseJSON, defaultOptions, genericToJSON, SumEncoding(..) )
import Data.Swagger (ToSchema)
import Data.Text qualified as T
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Prelude
data DocumentUpload = DocumentUpload
{ _du_abstract :: T.Text
, _du_authors :: T.Text
, _du_sources :: T.Text
, _du_title :: T.Text
, _du_date :: T.Text
, _du_language :: T.Text
}
deriving (Generic)
$(makeLenses ''DocumentUpload)
instance ToSchema DocumentUpload
instance FromJSON DocumentUpload
where
parseJSON = genericParseJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
instance ToJSON DocumentUpload
where
toJSON = genericToJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
......@@ -17,22 +17,21 @@ module Gargantext.API.Node.DocumentsFromWriteNodes
where
import Conduit ( yieldMany )
import Data.Aeson ( genericParseJSON, defaultOptions, genericToJSON )
import Data.List qualified as List
import Data.Swagger ( ToSchema )
import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser, auth_node_id, auth_user_id )
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
import Gargantext.API.Node.DocumentsFromWriteNodes.Types
import Gargantext.API.Prelude (GargM)
import Gargantext.API.Routes.Named.Document qualified as Named
import Gargantext.Core (Lang(..))
import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion)
import Gargantext.Core.Text.Corpus.Parsers.Date (split')
import Gargantext.Core.Text.Corpus.Parsers.FrameWrite
import Gargantext.Core.Text.List.Social (FlowSocialListWith)
import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow (flowDataText, DataText(..))
......@@ -46,30 +45,13 @@ import Gargantext.Prelude
import Gargantext.System.Logging
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Gargantext.Utils.Jobs.Error
import Servant ( JSON, Summary, type (:>), HasServer(ServerT) )
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
type API = Summary " Documents from Write nodes."
:> AsyncJobs JobLog '[JSON] Params JobLog
------------------------------------------------------------------------
data Params = Params
{ id :: Int
, paragraphs :: Text
, lang :: Lang
, selection :: FlowSocialListWith
}
deriving (Generic, Show)
instance FromJSON Params where
parseJSON = genericParseJSON defaultOptions
instance ToJSON Params where
toJSON = genericToJSON defaultOptions
instance ToSchema Params
------------------------------------------------------------------------
api :: AuthenticatedUser
-- ^ The logged-in user
-> NodeId
-> ServerT API (GargM Env BackendInternalError)
api authenticatedUser nId =
-> Named.DocumentsFromWriteNodesAPI (AsServerT (GargM Env BackendInternalError))
api authenticatedUser nId = Named.DocumentsFromWriteNodesAPI $ AsyncJobs $
serveJobsAPI DocumentFromWriteNodeJob $ \jHandle p ->
documentsFromWriteNodes authenticatedUser nId p jHandle
......
module Gargantext.API.Node.DocumentsFromWriteNodes.Types where
import Data.Aeson ( genericParseJSON, defaultOptions, genericToJSON )
import Data.Swagger ( ToSchema )
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.List.Social (FlowSocialListWith)
import Gargantext.Prelude
------------------------------------------------------------------------
data Params = Params
{ id :: Int
, paragraphs :: Text
, lang :: Lang
, selection :: FlowSocialListWith
}
deriving (Generic, Show)
instance FromJSON Params where
parseJSON = genericParseJSON defaultOptions
instance ToJSON Params where
toJSON = genericToJSON defaultOptions
instance ToSchema Params
------------------------------------------------------------------------
......@@ -17,19 +17,17 @@ Portability : POSIX
module Gargantext.API.Node.File where
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.MIME.Types qualified as DMT
import Data.Swagger (ToSchema(..))
import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser, auth_user_id )
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node.File.Types
import Gargantext.API.Node.Types ( NewWithFile(NewWithFile) )
import Gargantext.API.Prelude ( GargM, GargServer )
import Gargantext.Core.Types (TODO)
import Gargantext.API.Prelude ( GargM )
import Gargantext.API.Routes.Named.File qualified as Named
import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
import Gargantext.Database.Action.Node (mkNodeWithParent)
import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) )
......@@ -40,40 +38,14 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Network.HTTP.Media qualified as M
import Servant
import Servant.Server.Generic (AsServerT)
data RESPONSE deriving Typeable
instance Accept RESPONSE where
contentType _ = "text" M.// "*"
instance MimeRender RESPONSE BSResponse where
mimeRender _ (BSResponse val) = BSL.fromStrict $ val
type FileApi = Summary "File download"
:> "download"
:> Get '[RESPONSE] (Headers '[Servant.Header "Content-Type" Text] BSResponse)
instance MimeUnrender RESPONSE BSResponse where
mimeUnrender _ lbs = Right $ BSResponse (BSL.toStrict lbs)
fileApi :: NodeId -> GargServer FileApi
fileApi :: (HasSettings env, FlowCmdM env err m)
=> NodeId
-> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
fileApi nId = fileDownload nId
newtype Contents = Contents BS.ByteString
instance GargDB.ReadFile Contents where
readFile' fp = do
c <- BS.readFile fp
pure $ Contents c
newtype BSResponse = BSResponse BS.ByteString
deriving (Generic)
instance ToSchema BSResponse where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
fileDownload :: (HasSettings env, FlowCmdM env err m)
=> NodeId
-> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
......@@ -102,17 +74,11 @@ fileDownload nId = do
-- let settings = embeddedSettings [("", "hello")]
-- Tagged $ staticApp settings
type FileAsyncApi = Summary "File Async Api"
:> "file"
:> "add"
:> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
fileAsyncApi :: AuthenticatedUser
-- ^ The logged-in user
-> NodeId
-> ServerT FileAsyncApi (GargM Env BackendInternalError)
fileAsyncApi authenticatedUser nId =
-> Named.FileAsyncAPI (AsServerT (GargM Env BackendInternalError))
fileAsyncApi authenticatedUser nId = Named.FileAsyncAPI $ AsyncJobs $
serveJobsAPI AddFileJob $ \jHandle i ->
addWithFile authenticatedUser nId i jHandle
......
module Gargantext.API.Node.File.Types where
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.Swagger (ToSchema(..))
import Gargantext.Core.Types (TODO)
import Gargantext.Database.GargDB qualified as GargDB
import Gargantext.Prelude
import Network.HTTP.Media qualified as M
import Servant
data RESPONSE deriving Typeable
instance Accept RESPONSE where
contentType _ = "text" M.// "*"
instance MimeRender RESPONSE BSResponse where
mimeRender _ (BSResponse val) = BSL.fromStrict $ val
instance MimeUnrender RESPONSE BSResponse where
mimeUnrender _ lbs = Right $ BSResponse (BSL.toStrict lbs)
newtype Contents = Contents BS.ByteString
instance GargDB.ReadFile Contents where
readFile' fp = do
c <- BS.readFile fp
pure $ Contents c
newtype BSResponse = BSResponse BS.ByteString
deriving (Generic)
instance ToSchema BSResponse where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
......@@ -17,19 +17,18 @@ module Gargantext.API.Node.FrameCalcUpload where
import Data.ByteString.Lazy qualified as BSL
import Data.ByteString.UTF8 qualified as BSU8
import Data.Swagger ( ToSchema )
import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types ( auth_node_id, AuthenticatedUser )
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node.Corpus.New (addToCorpusWithForm)
import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..))
import Gargantext.API.Node.FrameCalcUpload.Types
import Gargantext.API.Node.Types (NewWithForm(..))
import Gargantext.API.Prelude ( GargM )
import Gargantext.Core (Lang)
import Gargantext.API.Routes.Named.FrameCalc qualified as Named
import Gargantext.Core.NodeStory.Types ( HasNodeArchiveStoryImmediateSaver )
import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
import Gargantext.Database.Admin.Types.Hyperdata.Frame ( HyperdataFrame(..) )
......@@ -41,29 +40,11 @@ import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..), markFailureNoErr)
import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Servant ( type (:>), JSON, Summary, HasServer(ServerT) )
import Web.FormUrlEncoded (FromForm)
import Servant.Server.Generic (AsServerT)
data FrameCalcUpload = FrameCalcUpload {
_wf_lang :: !(Maybe Lang)
, _wf_selection :: !FlowSocialListWith
}
deriving (Generic)
instance FromForm FrameCalcUpload
instance FromJSON FrameCalcUpload
instance ToJSON FrameCalcUpload
instance ToSchema FrameCalcUpload
type API = Summary " FrameCalc upload"
:> "add"
:> "framecalc"
:> "async"
:> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
api :: AuthenticatedUser -> NodeId -> ServerT API (GargM Env BackendInternalError)
api authenticatedUser nId =
api :: AuthenticatedUser -> NodeId -> Named.FrameCalcAPI (AsServerT (GargM Env BackendInternalError))
api authenticatedUser nId = Named.FrameCalcAPI $ AsyncJobs $
serveJobsAPI UploadFrameCalcJob $ \jHandle p ->
frameCalcUploadAsync authenticatedUser nId p jHandle
......
module Gargantext.API.Node.FrameCalcUpload.Types where
import Data.Swagger ( ToSchema )
import Gargantext.Core (Lang)
import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
import Gargantext.Prelude
import Web.FormUrlEncoded (FromForm)
data FrameCalcUpload = FrameCalcUpload {
_wf_lang :: !(Maybe Lang)
, _wf_selection :: !FlowSocialListWith
}
deriving (Generic)
instance FromForm FrameCalcUpload
instance FromJSON FrameCalcUpload
instance ToJSON FrameCalcUpload
instance ToSchema FrameCalcUpload
......@@ -22,32 +22,16 @@ module Gargantext.API.Node.Get
import Data.Aeson
import Data.Swagger
import Gargantext.API.Prelude
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (JSONB)
import Gargantext.Prelude
import Servant
import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
type API a = Summary "Polymorphic Get Node Endpoint"
:> ReqBody '[JSON] GetNodeParams
:> Get '[JSON] (Node a)
------------------------------------------------------------------------
data GetNodeParams = GetNodeParams { node_id :: NodeId
, nodetype :: NodeType
}
deriving (Generic)
----------------------------------------------------------------------
api :: forall proxy a.
( JSONB a
, FromJSON a
, ToJSON a
) => proxy a -> UserId -> NodeId -> GargServer (API a)
api _p _uId _nId (GetNodeParams _nId' _nt) = undefined
------------------------------------------------------------------------
instance FromJSON GetNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
......
......@@ -21,13 +21,13 @@ module Gargantext.API.Node.New
where
import Control.Lens hiding (elements, Empty)
import Data.Aeson
import Data.Swagger
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs (..))
import Gargantext.API.Errors.Types
import Gargantext.API.Node.New.Types
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Node qualified as Named
import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Action.Node
import Gargantext.Database.Admin.Types.Node
......@@ -35,24 +35,7 @@ import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
import Web.FormUrlEncoded (FromForm, ToForm)
------------------------------------------------------------------------
data PostNode = PostNode { pn_name :: Text
, pn_typename :: NodeType}
deriving (Generic)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON PostNode
instance ToJSON PostNode
instance ToSchema PostNode
instance FromForm PostNode
instance ToForm PostNode
instance Arbitrary PostNode where
arbitrary = elements [PostNode "Node test" NodeCorpus]
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
postNode :: HasNodeError err
......@@ -65,19 +48,13 @@ postNode authenticatedUser pId (PostNode nodeName nt) = do
let userId = authenticatedUser ^. auth_user_id
mkNodeWithParent nt (Just pId) userId nodeName
------------------------------------------------------------------------
type PostNodeAsync = Summary "Post Node"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
postNodeAsyncAPI
:: AuthenticatedUser
-- ^ The logged-in user
-> NodeId
-- ^ The target node
-> ServerT PostNodeAsync (GargM Env BackendInternalError)
postNodeAsyncAPI authenticatedUser nId =
-> Named.PostNodeAsyncAPI (AsServerT (GargM Env BackendInternalError))
postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync authenticatedUser nId p jHandle
------------------------------------------------------------------------
......
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]
......@@ -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
......@@ -13,7 +13,6 @@ Portability : POSIX
module Gargantext.API.Node.Phylo.Export.Types where
import Data.Aeson
import Data.Aeson.TH (deriveJSON)
-- import Data.Csv (DefaultOrdered(..), ToNamedRecord(..), (.=), header, namedRecord)
import Data.Swagger ( genericDeclareNamedSchema, ToParamSchema(..), ToSchema(..) )
......@@ -27,7 +26,7 @@ import Gargantext.Database.Admin.Types.Node (PhyloId)
-- import Gargantext.Utils.Servant (ZIP)
-- import Gargantext.Utils.Zip (zipContentsPure)
import Protolude
import Servant ((:>), (:<|>), Get, Header, Headers(..), JSON, Summary) --, PlainText, MimeRender(..)
--, PlainText, MimeRender(..)
-- | Phylo Export
......@@ -97,14 +96,6 @@ instance ToParamSchema Phylo where
toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
--------------------------------------------------
type API = Summary "Phylo Export"
:> "export"
:> ( "json"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Value)
:<|> "dot"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Text)
)
-- type API = Summary "Phylo Export"
-- :> "export"
-- :> Get '[JSON,DOT] (Headers '[Servant.Header "Content-Disposition" Text] Value)
......
......@@ -15,11 +15,11 @@ Portability : POSIX
module Gargantext.API.Node.Share
where
import Data.Aeson
import Data.List qualified as List
import Data.Swagger
import Data.Text qualified as Text
import Gargantext.API.Node.Share.Types
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Share qualified as Named
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
import Gargantext.Database.Action.Share (ShareNodeWith(..))
......@@ -31,26 +31,8 @@ import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Tree (findNodesWithType)
import Gargantext.Prelude
import Gargantext.Utils.Aeson qualified as GUA
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
data ShareNodeParams = ShareTeamParams { username :: Text }
| SharePublicParams { node_id :: NodeId }
deriving (Generic)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON ShareNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON ShareNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema ShareNodeParams
instance Arbitrary ShareNodeParams where
arbitrary = elements [ ShareTeamParams "user1"
, SharePublicParams (UnsafeMkNodeId 1)
]
------------------------------------------------------------------------
-- TODO permission
-- TODO refactor userId which is used twice
......@@ -98,15 +80,5 @@ api _uId nId2 (SharePublicParams nId1) =
fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2
------------------------------------------------------------------------
type API = Summary " Share Node with username"
:> ReqBody '[JSON] ShareNodeParams
:> Post '[JSON] Int
------------------------------------------------------------------------
type Unpublish = Summary " Unpublish Node"
:> Capture "node_id" NodeId
:> Put '[JSON] Int
unPublish :: NodeId -> GargServer Unpublish
unPublish n = DB.unPublish n
unPublish :: IsGargServer env err m => NodeId -> Named.Unpublish (AsServerT m)
unPublish n = Named.Unpublish $ DB.unPublish n
module Gargantext.API.Node.Share.Types where
import Data.Aeson
import Data.Swagger
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude
import Gargantext.Utils.Aeson qualified as GUA
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
data ShareNodeParams = ShareTeamParams { username :: Text }
| SharePublicParams { node_id :: NodeId }
deriving (Generic)
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON ShareNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON ShareNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema ShareNodeParams
instance Arbitrary ShareNodeParams where
arbitrary = elements [ ShareTeamParams "user1"
, SharePublicParams (UnsafeMkNodeId 1)
]
......@@ -6,24 +6,20 @@ module Gargantext.API.Node.ShareURL where
import Data.Text
import Gargantext.Prelude
import Gargantext.API.Prelude
import Servant
import Gargantext.Core.Types (NodeType, NodeId, unNodeId)
import Gargantext.Database.Prelude (HasConfig (hasConfig), CmdCommon)
import Control.Lens.Getter (view)
import Gargantext.Prelude.Config (gc_url)
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors (BackendInternalError)
import Gargantext.API.Routes.Named.Share qualified as Named
import Servant.Server.Generic (AsServerT)
type API = Summary "Fetch URL for sharing a node"
:> QueryParam "type" NodeType
:> QueryParam "id" NodeId
:> Get '[JSON] Text
shareURL :: IsGargServer env err m => Named.ShareURL (AsServerT m)
shareURL = Named.ShareURL getUrl
api :: ServerT API (GargM Env BackendInternalError)
api = getUrl
getUrl :: (CmdCommon env) =>
Maybe NodeType -> Maybe NodeId -> GargM env BackendInternalError Text
getUrl :: (IsGargServer env err m, CmdCommon env)
=> Maybe NodeType
-> Maybe NodeId
-> m Text
getUrl nt id = do
-- TODO add check that the node is able to be shared (in a shared folder)
case nt of
......
......@@ -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
......@@ -16,24 +16,21 @@ module Gargantext.API.Node.Update
where
import Control.Lens (view)
import Data.Aeson
import Data.Set qualified as Set
import Data.Swagger ( ToSchema )
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Metrics qualified as Metrics
import Gargantext.API.Ngrams.Types qualified as NgramsTypes
import Gargantext.API.Node.Update.Types
import Gargantext.API.Prelude (GargM, simuLogs)
import Gargantext.Core.Methods.Similarities (GraphMetric(..))
import Gargantext.API.Routes.Named.Node qualified as Named
import Gargantext.Core.NodeStory.Types (HasNodeStory)
import Gargantext.Core.Text.Ngrams (NgramsType(NgramsTerms))
import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Core.Viz.Graph.API (recomputeGraph)
import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
import Gargantext.Core.Viz.Graph.Types (Strength)
import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..), subConfigAPI2config)
import Gargantext.Core.Viz.Phylo (subConfigAPI2config)
import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
import Gargantext.Database.Action.Flow (reIndexWith)
import Gargantext.Database.Action.Flow.Pairing (pairing)
......@@ -45,53 +42,13 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_parent_id)
import Gargantext.Prelude
import Gargantext.System.Logging ( MonadLogger )
import Gargantext.Utils.Aeson qualified as GUA
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Gargantext.Utils.UTCTime (timeMeasured)
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
type API = Summary " Update node according to NodeType params"
:> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
------------------------------------------------------------------------
data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
, methodGraphNodeType2 :: !NgramsType
}
| UpdateNodeParamsTexts { methodTexts :: !Granularity }
| UpdateNodeParamsBoard { methodBoard :: !Charts }
| LinkNodeReq { nodeType :: !NodeType
, id :: !NodeId }
| UpdateNodePhylo { config :: !PhyloSubConfigAPI }
deriving (Generic)
----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Granularity = NewNgrams | NewTexts | Both
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Charts = Sources | Authors | Institutes | Ngrams | All
deriving (Generic, Eq, Ord, Enum, Bounded)
------------------------------------------------------------------------
api :: NodeId -> ServerT API (GargM Env BackendInternalError)
api nId =
api :: NodeId -> Named.UpdateAPI (AsServerT (GargM Env BackendInternalError))
api nId = Named.UpdateAPI $ AsyncJobs $
serveJobsAPI UpdateNodeJob $ \jHandle p ->
updateNode nId p jHandle
......@@ -206,39 +163,3 @@ updateDocs cId = do
-- printDebug "updateContextsScore" (cId, lId, u)
pure ()
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON UpdateNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON UpdateNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema UpdateNodeParams
instance Arbitrary UpdateNodeParams where
arbitrary = do
l <- UpdateNodeParamsList <$> arbitrary
g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
t <- UpdateNodeParamsTexts <$> arbitrary
b <- UpdateNodeParamsBoard <$> arbitrary
elements [l,g,t,b]
instance FromJSON Method
instance ToJSON Method
instance ToSchema Method
instance Arbitrary Method where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Granularity
instance ToJSON Granularity
instance ToSchema Granularity
instance Arbitrary Granularity where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Charts
instance ToJSON Charts
instance ToSchema Charts
instance Arbitrary Charts where
arbitrary = elements [ minBound .. maxBound ]
------------------------------------------------------------------------
module Gargantext.API.Node.Update.Types where
import Data.Aeson
import Data.Swagger ( ToSchema )
import Gargantext.Core.Methods.Similarities (GraphMetric(..))
import Gargantext.Core.Text.Ngrams (NgramsType)
import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
import Gargantext.Core.Viz.Graph.Types (Strength)
import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType )
import Gargantext.Prelude
import Gargantext.Utils.Aeson qualified as GUA
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
------------------------------------------------------------------------
data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
, methodGraphNodeType2 :: !NgramsType
}
| UpdateNodeParamsTexts { methodTexts :: !Granularity }
| UpdateNodeParamsBoard { methodBoard :: !Charts }
| LinkNodeReq { nodeType :: !NodeType
, id :: !NodeId }
| UpdateNodePhylo { config :: !PhyloSubConfigAPI }
deriving (Generic)
----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Granularity = NewNgrams | NewTexts | Both
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Charts = Sources | Authors | Institutes | Ngrams | All
deriving (Generic, Eq, Ord, Enum, Bounded)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON UpdateNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON UpdateNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema UpdateNodeParams
instance Arbitrary UpdateNodeParams where
arbitrary = do
l <- UpdateNodeParamsList <$> arbitrary
g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
t <- UpdateNodeParamsTexts <$> arbitrary
b <- UpdateNodeParamsBoard <$> arbitrary
elements [l,g,t,b]
instance FromJSON Method
instance ToJSON Method
instance ToSchema Method
instance Arbitrary Method where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Granularity
instance ToJSON Granularity
instance ToSchema Granularity
instance Arbitrary Granularity where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Charts
instance ToJSON Charts
instance ToSchema Charts
instance Arbitrary Charts where
arbitrary = elements [ minBound .. maxBound ]
------------------------------------------------------------------------
......@@ -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.
......
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" }
This diff is collapsed.
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named where
{-# LANGUAGE TypeApplications #-}
module Gargantext.API.Routes.Named (
-- * Routes types
API(..)
, NamedAPI(..)
, SwaggerAPI(..)
, BackEndAPI(..)
, MkBackEndAPI(..)
, GargAPIVersion(..)
, GargAPI'(..)
, AuthAPI(..)
, ForgotPasswordAPI(..)
, ForgotPasswordAsyncAPI(..)
, GargVersion(..)
) where
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Auth (ForgotPasswordAsyncParams)
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Routes.Named.Public
import Gargantext.API.GraphQL qualified as GraphQL
import Gargantext.API.Routes.Named.Private
import Gargantext.API.Routes.Named.Public
import Gargantext.API.Routes.Types
import Servant.API ((:>), (:-), JSON, ReqBody, Post, Get, QueryParam)
import Servant.API.Description (Summary)
import Servant.API.NamedRoutes
import Servant.Auth.Swagger ()
import Servant.Swagger.UI
type GargAPI = NamedRoutes (MkGargAPI (GargAPIVersion GargAPI'))
newtype API mode = API
{ apiWithCustomErrorScheme :: mode :- WithCustomErrorScheme (NamedRoutes NamedAPI)
} deriving Generic
data NamedAPI mode = NamedAPI
{ swaggerAPI :: mode :- SwaggerSchemaUI "swagger-ui" "swagger.json"
, backendAPI :: mode :- NamedRoutes BackEndAPI
, graphqlAPI :: mode :- GraphQL.API -- FIXME(adn) convert to named!
, frontendAPI :: mode :- FrontEndAPI
} deriving Generic
newtype SwaggerAPI mode = SwaggerAPI
{ swaggerSchemaEp :: mode :- SwaggerSchemaUI "swagger-ui" "swagger.json"
} deriving Generic
newtype BackEndAPI mode = BackEndAPI {
backendAPI' :: mode :- NamedRoutes (MkBackEndAPI (GargAPIVersion GargAPI'))
} deriving Generic
data MkGargAPI sub mode = MkGargAPI
{ mkGargAPI :: mode :- "api" :> Summary "API " :> NamedRoutes sub
newtype MkBackEndAPI sub mode = MkBackEndAPI
{ mkBackEndAPI :: mode :- "api" :> Summary "Backend API " :> NamedRoutes sub
} deriving Generic
data GargAPIVersion sub mode = GargAPIVersion
newtype GargAPIVersion sub mode = GargAPIVersion
{ gargAPIVersion :: mode :- "v1.0" :> Summary "Garg API Version " :> NamedRoutes sub
} deriving Generic
......@@ -38,7 +77,7 @@ data GargAPI' mode = GargAPI'
} deriving Generic
data AuthAPI mode = AuthAPI
newtype AuthAPI mode = AuthAPI
{ authEp :: mode :- "auth" :> Summary "AUTH API"
:> ReqBody '[JSON] AuthRequest
:> Post '[JSON] AuthResponse
......@@ -57,10 +96,10 @@ data ForgotPasswordAPI mode = ForgotPasswordAPI
data ForgotPasswordAsyncAPI mode = ForgotPasswordAsyncAPI
{ forgotPasswordAsyncEp :: mode :- Summary "Forgot password asnc"
:> AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog)
} deriving Generic
data GargVersion mode = GargVersion
{ gargVersionEp :: "version" :> Summary "Backend version" :> Get '[JSON] Text
{ gargVersionEp :: mode :- "version" :> Summary "Backend version" :> Get '[JSON] Text
} deriving Generic
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Annuaire (
-- * Routes types
AddAnnuaireWithForm(..)
) where
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
import Gargantext.Database.Admin.Types.Node
import Servant
newtype AddAnnuaireWithForm mode = AddAnnuaireWithForm
{ addWithFormEp :: mode :- Summary "Add with FormUrlEncoded to annuaire endpoint"
:> "annuaire"
:> Capture "annuaire_id" AnnuaireId
:> "add"
:> "form"
:> "async"
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog)
} deriving Generic
......@@ -10,9 +10,9 @@ module Gargantext.API.Routes.Named.Contact (
) where
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Contact.Types (AddContactParams(..))
import Gargantext.API.Routes.Named.Node (NodeNodeAPI(..))
import Gargantext.Database.Admin.Types.Hyperdata.Contact
import Gargantext.Database.Admin.Types.Node
......@@ -26,13 +26,5 @@ data ContactAPI mode = ContactAPI
newtype ContactAsyncAPI mode = ContactAsyncAPI
{ addContactAsyncEp :: mode :- AsyncJobs JobLog '[JSON] AddContactParams JobLog
{ addContactAsyncEp :: mode :- NamedRoutes (AsyncJobs JobLog '[JSON] AddContactParams JobLog)
} deriving Generic
data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
| AddContactParamsAdvanced { firstname :: !Text
, lastname :: !Text
-- TODO add others fields
}
deriving Generic
{-# 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
......@@ -10,7 +10,6 @@ module Gargantext.API.Routes.Named.Corpus (
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Corpus.Annuaire hiding (AddWithForm)
import Gargantext.API.Node.Corpus.Export.Types
import Gargantext.API.Node.Types
import Gargantext.Core.Text.Ngrams (NgramsType(..))
......@@ -27,20 +26,19 @@ newtype CorpusExportAPI mode = CorpusExportAPI
} deriving Generic
newtype AddWithForm mode = AddWithForm
{ addWithFormEp :: mode :- Summary "Add with FormUrlEncoded to annuaire endpoint"
:> "annuaire"
:> Capture "annuaire_id" AnnuaireId
{ addWithFormEp :: mode :- Summary "Add with FormUrlEncoded to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog)
} deriving Generic
newtype AddWithQuery mode = AddWithQuery
{ addWithQueryEp :: mode :- Summary "Add with Query to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "query"
:> AsyncJobs JobLog '[JSON] WithQuery JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] WithQuery JobLog)
} deriving Generic
......@@ -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
......
......@@ -6,49 +6,38 @@ module Gargantext.API.Routes.Named.Document (
DocumentsFromWriteNodesAPI(..)
, DocumentUploadAPI(..)
, DocumentExportAPI(..)
, DocumentExportEndpoints(..)
-- * API types
, Params(..)
, DocumentUpload(..)
-- * functions and lenses
, du_title
, du_sources
, du_language
, du_date
, du_authors
, du_abstract
) where
import Control.Lens
import Data.Aeson
import Data.Swagger hiding (fieldLabelModifier)
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Document.Export.Types
import Gargantext.Core
import Gargantext.Core.Text.List.Social
import Gargantext.Core.Utils.Prefix
import Gargantext.API.Node.DocumentsFromWriteNodes.Types ( Params(..) )
import Gargantext.API.Node.DocumentUpload.Types ( DocumentUpload(..), )
import Gargantext.Utils.Servant (ZIP)
import Prelude
import Servant
newtype DocumentExportAPI mode = DocumentExportAPI
{ documentExportAPI ::
mode :- Summary "Document Export"
:> "export"
:> ( "json"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
:<|> "json.zip"
:> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
:<|> "csv"
:> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text) )
{ documentExportAPI :: mode :- Summary "Document Export" :> "export" :> NamedRoutes DocumentExportEndpoints
} deriving Generic
data DocumentExportEndpoints mode = DocumentExportEndpoints
{ exportJSONEp :: mode :- "json"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
, exportJSONZipEp :: mode :- "json.zip"
:> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
, exportCSVEp :: mode :- "csv"
:> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text)
} deriving Generic
newtype DocumentsFromWriteNodesAPI mode = DocumentsFromWriteNodesAPI
{ docFromWriteNodesEp :: mode :- Summary " Documents from Write nodes."
:> AsyncJobs JobLog '[JSON] Params JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] Params JobLog)
} deriving Generic
......@@ -57,61 +46,5 @@ newtype DocumentUploadAPI mode = DocumentUploadAPI
:> "document"
:> "upload"
:> "async"
:> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] DocumentUpload JobLog)
} deriving Generic
data Params = Params
{ id :: Int
, paragraphs :: Text
, lang :: Lang
, selection :: FlowSocialListWith
}
deriving (Generic, Show)
data DocumentUpload = DocumentUpload
{ _du_abstract :: Text
, _du_authors :: Text
, _du_sources :: Text
, _du_title :: Text
, _du_date :: Text
, _du_language :: Text
}
deriving Generic
--
-- instances
--
instance FromJSON Params where
parseJSON = genericParseJSON defaultOptions
instance ToJSON Params where
toJSON = genericToJSON defaultOptions
instance ToSchema Params
$(makeLenses ''DocumentUpload)
instance ToSchema DocumentUpload
instance FromJSON DocumentUpload
where
parseJSON = genericParseJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
instance ToJSON DocumentUpload
where
toJSON = genericToJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
{-# 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
......@@ -9,9 +9,9 @@ module Gargantext.API.Routes.Named.File (
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.File
import Gargantext.API.Node.Types
import Servant
import Gargantext.API.Node.File.Types
data FileAPI mode = FileAPI
{ fileDownloadEp :: mode :- Summary "File download"
......@@ -24,6 +24,6 @@ data FileAsyncAPI mode = FileAsyncAPI
{ addFileAsyncEp :: mode :- Summary "File Async Api"
:> "file"
:> "add"
:> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog)
} deriving Generic
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.FrameCalc where
module Gargantext.API.Routes.Named.FrameCalc (
-- * Routes types
FrameCalcAPI(..)
) where
import Servant
import GHC.Generics
import Gargantext.API.Node.FrameCalcUpload (FrameCalcUpload)
import Gargantext.API.Node.FrameCalcUpload.Types (FrameCalcUpload)
import Gargantext.API.Admin.Orchestrator.Types
data FrameCalcAPI mode = FrameCalcAPI
newtype FrameCalcAPI mode = FrameCalcAPI
{ frameCalcUploadEp :: mode :- Summary " FrameCalc upload"
:> "add"
:> "framecalc"
:> "async"
:> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog)
} deriving Generic
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.List where
module Gargantext.API.Routes.Named.List (
-- * Routes types
GETAPI(..)
, ListEndpoints(..)
, JSONAPI(..)
, CSVAPI(..)
) where
import Data.Text (Text)
import GHC.Generics
......@@ -16,14 +22,16 @@ newtype GETAPI mode = GETAPI
{ getListEp :: mode :- Summary "Get List"
:> "lists"
:> Capture "listId" ListId
:> ( "json"
:> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
:<|> "json.zip"
:> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
:<|> "csv"
:> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap) )
:> NamedRoutes ListEndpoints
} deriving Generic
data ListEndpoints mode = ListEndpoints
{ listJSONEp :: mode :- "json"
:> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
, listJSONZipEp :: mode :- "json.zip"
:> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
, listCSVEp :: mode :- "csv" :> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap)
} deriving Generic
newtype JSONAPI mode = JSONAPI
{ updateListJSONEp :: mode :- Summary "Update List"
......@@ -32,7 +40,7 @@ newtype JSONAPI mode = JSONAPI
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog)
} deriving Generic
......@@ -44,5 +52,5 @@ newtype CSVAPI mode = CSVAPI
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog)
} deriving Generic
......@@ -7,7 +7,7 @@ module Gargantext.API.Routes.Named.Node (
, PostNodeAPI(..)
, ChildrenAPI(..)
, NodeNodeAPI(..)
, PostNodeAsync(..)
, PostNodeAsyncAPI(..)
, CatAPI(..)
, UpdateAPI(..)
, MoveAPI(..)
......@@ -16,6 +16,7 @@ module Gargantext.API.Routes.Named.Node (
, Pairs(..)
, Roots(..)
, NodesAPI(..)
, ScoreAPI(..)
-- * API types (might appear in the routes)
, Charts(..)
......@@ -27,9 +28,6 @@ module Gargantext.API.Routes.Named.Node (
, UpdateNodeParams(..)
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Auth.PolicyCheck ( PolicyChecked )
......@@ -42,20 +40,15 @@ import Gargantext.API.Routes.Named.Viz
import Gargantext.API.Routes.Named.Search
import Gargantext.API.Routes.Named.Share as Share
import Gargantext.API.Routes.Named.Table
import Gargantext.API.Routes.Named.Tree
import Gargantext.Core.Methods.Similarities
import Gargantext.Core.Text.Ngrams
import Gargantext.API.Node.Types ( RenameNode(..), NodesToScore(..), NodesToCategory(..) )
import Gargantext.API.Node.New.Types ( PostNode(..) )
import Gargantext.API.Node.Update.Types ( UpdateNodeParams(..), Charts(..), Granularity(..), Method(..) )
import Gargantext.Core.Types
import Gargantext.Core.Types.Query
import Gargantext.Core.Viz.Graph.Tools
import Gargantext.Core.Viz.Graph.Types hiding (Node)
import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
import Gargantext.Database.Query.Facet.Types ( FacetDoc, OrderBy(..) )
import Prelude
import Servant
import Test.QuickCheck
import Web.FormUrlEncoded (FromForm, ToForm)
-------------------------------------------------------------------
-- | Node API Types management
......@@ -72,11 +65,11 @@ import Web.FormUrlEncoded (FromForm, ToForm)
-- CanFavorite
-- CanMoveToTrash
data NodeAPI mode a = NodeAPI
data NodeAPI a mode = NodeAPI
{ nodeNodeAPI :: mode :- PolicyChecked (NamedRoutes (NodeNodeAPI a))
, renameAPI :: mode :- "rename" :> NamedRoutes RenameAPI
, postNodeAPI :: mode :- NamedRoutes PostNodeAPI -- TODO move to children POST
, postNodeAsync :: mode :- NamedRoutes PostNodeAsync
, postNodeAsyncAPI :: mode :- NamedRoutes PostNodeAsyncAPI
, frameCalcUploadAPI :: mode :- NamedRoutes FrameCalcAPI
, putEp :: mode :- ReqBody '[JSON] a :> Put '[JSON] Int
, updateAPI :: mode :- "update" :> NamedRoutes UpdateAPI
......@@ -88,15 +81,15 @@ data NodeAPI mode a = NodeAPI
, scoreAPI :: mode :- "score" :> NamedRoutes ScoreAPI
, searchAPI :: mode :- "search" :> NamedRoutes (SearchAPI SearchResult)
, shareAPI :: mode :- "share" :> NamedRoutes ShareNode
-- Pairing utilities
---- Pairing utilities
, pairWithEp :: mode :- "pairwith" :> NamedRoutes PairWith
, pairsEp :: mode :- "pairs" :> NamedRoutes Pairs
, pairingEp :: mode :- "pairing" :> NamedRoutes PairingAPI
-- VIZ
---- VIZ
, scatterAPI :: mode :- "metrics" :> NamedRoutes ScatterAPI
, charAPI :: mode :- "chart" :> NamedRoutes ChartAPI
, chartAPI :: mode :- "chart" :> NamedRoutes ChartAPI
, pieAPI :: mode :- "pie" :> NamedRoutes PieAPI
, treeAPI :: mode :- "tree" :> NamedRoutes NodeTreeAPI
, treeAPI :: mode :- "tree" :> NamedRoutes TreeAPI
, phyloAPI :: mode :- "phylo" :> NamedRoutes PhyloAPI
, moveAPI :: mode :- "move" :> NamedRoutes MoveAPI
, unpublishEp :: mode :- "unpublish" :> NamedRoutes Share.Unpublish
......@@ -124,11 +117,11 @@ newtype PostNodeAPI mode = PostNodeAPI
newtype ChildrenAPI a mode = ChildrenAPI
{ summaryChildrenEp :: Summary " Summary children"
:> QueryParam "type" NodeType
:> QueryParam "offset" Offset
:> QueryParam "limit" Limit
:> Get '[JSON] (NodeTableResult a)
{ summaryChildrenEp :: mode :- Summary " Summary children"
:> QueryParam "type" NodeType
:> QueryParam "offset" Offset
:> QueryParam "limit" Limit
:> Get '[JSON] (NodeTableResult a)
} deriving Generic
......@@ -137,10 +130,10 @@ newtype NodeNodeAPI a mode = NodeNodeAPI
} deriving Generic
newtype PostNodeAsync mode = PostNodeAsync
newtype PostNodeAsyncAPI mode = PostNodeAsyncAPI
{ postNodeAsyncEp :: mode :- Summary "Post Node"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog)
} deriving Generic
......@@ -153,7 +146,7 @@ newtype CatAPI mode = CatAPI
newtype UpdateAPI mode = UpdateAPI
{ updateNodeEp :: mode :- Summary " Update node according to NodeType params"
:> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog)
} deriving Generic
......@@ -205,81 +198,3 @@ data Roots mode = Roots
newtype NodesAPI mode = NodesAPI
{ deleteNodeEp :: mode :- Delete '[JSON] Int
} deriving Generic
--
-- API types (might appears in the routes)
--
newtype RenameNode = RenameNode { r_name :: Text }
deriving Generic
data NodesToCategory = NodesToCategory
{ ntc_nodesId :: [NodeId]
, ntc_category :: Int
} deriving Generic
data PostNode = PostNode
{ pn_name :: Text
, pn_typename :: NodeType
} deriving Generic
data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
, methodGraphNodeType2 :: !NgramsType
}
| UpdateNodeParamsTexts { methodTexts :: !Granularity }
| UpdateNodeParamsBoard { methodBoard :: !Charts }
| LinkNodeReq { nodeType :: !NodeType
, id :: !NodeId }
| UpdateNodePhylo { config :: !PhyloSubConfigAPI }
deriving Generic
data Method = Basic | Advanced | WithModel
deriving (Generic, Eq, Ord, Enum, Bounded)
data Granularity = NewNgrams | NewTexts | Both
deriving (Generic, Eq, Ord, Enum, Bounded)
data Charts = Sources | Authors | Institutes | Ngrams | All
deriving (Generic, Eq, Ord, Enum, Bounded)
data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
, nts_score :: Int
}
deriving (Generic)
--
-- Instances
--
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON PostNode
instance ToJSON PostNode
instance ToSchema PostNode
instance FromForm PostNode
instance ToForm PostNode
instance Arbitrary PostNode where
arbitrary = elements [PostNode "Node test" NodeCorpus]
-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON NodesToScore
instance ToJSON NodesToScore
instance ToSchema NodesToScore
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module Gargantext.API.Routes.Named.Private (
-- * Routes types
GargPrivateAPI
GargPrivateAPI(..)
, MkProtectedAPI
, GargPrivateAPI'(..)
, GargAdminAPI(..)
, NodeEndpoint(..)
, NodeAPIEndpoint(..)
, MembersAPI(..)
, IsGenericNodeRoute(..)
) where
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Auth.Types
......@@ -20,7 +25,6 @@ import Gargantext.API.Routes.Named.Context
import Gargantext.API.Routes.Named.Corpus
import Gargantext.API.Routes.Named.Count
import Gargantext.API.Routes.Named.Document
import Gargantext.API.Routes.Named.Metrics
import Gargantext.API.Routes.Named.Node
import Gargantext.API.Routes.Named.List qualified as List
import Gargantext.API.Routes.Named.Share
......@@ -32,6 +36,8 @@ import Gargantext.Database.Admin.Types.Hyperdata.Corpus
import Gargantext.Database.Admin.Types.Node
import Servant.API
import Servant.Auth qualified as SA
import Data.Kind
import GHC.TypeLits
type MkProtectedAPI private = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> private
......@@ -44,13 +50,11 @@ newtype GargPrivateAPI mode = GargPrivateAPI
data GargPrivateAPI' mode = GargPrivateAPI'
{ gargAdminAPI :: mode :- NamedRoutes GargAdminAPI
, nodeEp :: mode :- NamedRoutes NodeEndpoint
, contextEp :: mode :- "context" :> Summary "Node endpoint"
, nodeEp :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataAny)
, contextEp :: mode :- "context" :> Summary "Context endpoint"
:> Capture "node_id" ContextId
:> NamedRoutes (ContextAPI HyperdataAny)
, corpusNodeAPI :: mode :- "corpus" :> Summary "Corpus endpoint"
:> Capture "corpus_id" CorpusId
:> NamedRoutes (NodeAPI HyperdataCorpus)
, corpusNodeAPI :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataCorpus)
, corpusNodeNodeAPI :: mode :- "corpus" :> Summary "Corpus endpoint"
:> Capture "node1_id" NodeId
:> "document"
......@@ -58,9 +62,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
:> NamedRoutes (NodeNodeAPI HyperdataAny)
, corpusExportAPI :: mode :- "corpus" :> Capture "node_id" CorpusId
:> NamedRoutes CorpusExportAPI
, annuaireEp :: mode :- "annuaire" :> Summary "Annuaire endpoint"
:> Capture "annuaire_id" AnnuaireId
:> NamedRoutes (NodeAPI HyperdataAnnuaire)
, annuaireEp :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataAnnuaire)
, contactAPI :: mode :- "annuaire" :> Summary "Contact endpoint"
:> Capture "annuaire_id" NodeId
:> NamedRoutes ContactAPI
......@@ -70,6 +72,8 @@ data GargPrivateAPI' mode = GargPrivateAPI'
:> NamedRoutes TableNgramsAPI
, documentExportAPI :: mode :- "texts" :> Capture "node_id" DocId
:> NamedRoutes DocumentExportAPI
, phyloExportAPI :: mode :- "phylo" :> Capture "node_id" DocId
:> NamedRoutes PhyloExportAPI
, countAPI :: mode :- "count" :> Summary "Count endpoint"
:> ReqBody '[JSON] Query
:> NamedRoutes CountAPI
......@@ -78,7 +82,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
:> NamedRoutes GraphAPI
, treeAPI :: mode :- "tree" :> Summary "Tree endpoint"
:> Capture "tree_id" NodeId
:> PolicyChecked (NamedRoutes TreeAPI)
:> PolicyChecked (NamedRoutes NodeTreeAPI)
, treeFlatAPI :: mode :- "treeflat" :> Summary "Flat tree endpoint"
:> Capture "tree_id" NodeId
:> NamedRoutes TreeFlatAPI
......@@ -99,15 +103,34 @@ data GargAdminAPI mode = GargAdminAPI
:> NamedRoutes NodesAPI
} deriving Generic
data NodeEndpoint mode = NodeEndpoint
{ nodeEndpointAPI :: mode :- "node" :> Summary "Node endpoint"
:> Capture "node_id" NodeId
:> NamedRoutes (NodeAPI HyperdataAny)
class IsGenericNodeRoute a where
type family TyToSubPath (a :: Type) :: Symbol
type family TyToCapture (a :: Type) :: Symbol
type family TyToSummary (a :: Type) :: Type
instance IsGenericNodeRoute HyperdataAny where
type instance TyToSubPath HyperdataAny = "node"
type instance TyToCapture HyperdataAny = "node_id"
type instance TyToSummary HyperdataAny = Summary "Node endpoint"
instance IsGenericNodeRoute HyperdataCorpus where
type instance TyToSubPath HyperdataCorpus = "corpus"
type instance TyToCapture HyperdataCorpus = "corpus_id"
type instance TyToSummary HyperdataCorpus = Summary "Corpus endpoint"
instance IsGenericNodeRoute HyperdataAnnuaire where
type instance TyToSubPath HyperdataAnnuaire = "annuaire"
type instance TyToCapture HyperdataAnnuaire = "annuaire_id"
type instance TyToSummary HyperdataAnnuaire = Summary "Annuaire endpoint"
newtype NodeAPIEndpoint a mode = NodeAPIEndpoint
{ nodeEndpointAPI :: mode :- TyToSubPath a
:> TyToSummary a
:> Capture (TyToCapture a) NodeId
:> NamedRoutes (NodeAPI a)
} deriving Generic
data MembersAPI mode = MembersAPI
newtype MembersAPI mode = MembersAPI
{ getMembersEp :: mode :- Get '[JSON] [Text]
}
} deriving Generic
{-# 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
......@@ -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]
......@@ -11,15 +11,13 @@ module Gargantext.API.Routes.Named.Share (
, ShareNodeParams(..)
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Node.Share.Types ( ShareNodeParams (..) )
import Gargantext.Database.Admin.Types.Node
import Gargantext.Utils.Aeson qualified as GUA
import Prelude
import Servant
import Test.QuickCheck
newtype ShareURL mode = ShareURL
{ shareUrlEp :: mode :- Summary "Fetch URL for sharing a node"
......@@ -39,25 +37,3 @@ newtype ShareNode mode = ShareNode
newtype Unpublish mode = Unpublish
{ unpublishEp :: mode :- Summary " Unpublish Node" :> Capture "node_id" NodeId :> Put '[JSON] Int
} deriving Generic
--
-- API Types
--
data ShareNodeParams = ShareTeamParams { username :: Text }
| SharePublicParams { node_id :: NodeId }
deriving (Generic)
--
-- Instances
--
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON ShareNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON ShareNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema ShareNodeParams
instance Arbitrary ShareNodeParams where
arbitrary = elements [ ShareTeamParams "user1"
, SharePublicParams (UnsafeMkNodeId 1)
]
......@@ -18,23 +18,20 @@ module Gargantext.API.Routes.Named.Table (
, FacetTableResult
) where
import Data.Aeson.TH
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.HashedResponse
import Gargantext.API.Ngrams.Types (TabType(..), UpdateTableNgramsCharts, Version, QueryParamR, Versioned, VersionedWithCount, NgramsTable, NgramsTablePatch)
import Gargantext.API.Ngrams.Types qualified as Ngrams
import Gargantext.API.Table.Types ( TableQuery(..), FacetTableResult )
import Gargantext.Core.Text.Corpus.Query (RawQuery)
import Gargantext.Core.Types (TableResult(..))
import Gargantext.Core.Types.Main (ListType)
import Gargantext.Core.Types.Query
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Database.Admin.Types.Node (ListId)
import Gargantext.Database.Query.Facet.Types
import Gargantext.Database.Query.Facet.Types qualified as Facet
import Prelude
import Servant
import Test.QuickCheck
data TableAPI mode = TableAPI
......@@ -42,7 +39,7 @@ data TableAPI mode = TableAPI
:> QueryParam "tabType" TabType
:> QueryParam "limit" Limit
:> QueryParam "offset" Offset
:> QueryParam "orderBy" OrderBy
:> QueryParam "orderBy" Facet.OrderBy
:> QueryParam "query" RawQuery
:> QueryParam "year" Text
:> Get '[JSON] (HashedResponse FacetTableResult)
......@@ -65,7 +62,7 @@ data TableNgramsAPI mode = TableNgramsAPI
} deriving Generic
data TableNgramsApiGet mode = TableNgramsApiGet
newtype TableNgramsApiGet mode = TableNgramsApiGet
{ getNgramsTableEp :: mode :- Summary " Table Ngrams API Get"
:> QueryParamR "ngramsType" TabType
:> QueryParamR "list" ListId
......@@ -74,13 +71,13 @@ data TableNgramsApiGet mode = TableNgramsApiGet
:> QueryParam "listType" ListType
:> QueryParam "minTermSize" MinSize
:> QueryParam "maxTermSize" MaxSize
:> QueryParam "orderBy" OrderBy
:> QueryParam "orderBy" Ngrams.OrderBy
:> QueryParam "search" Text
:> Get '[JSON] (VersionedWithCount NgramsTable)
} deriving Generic
data TableNgramsApiPut mode = TableNgramsApiPut
newtype TableNgramsApiPut mode = TableNgramsApiPut
{ putNgramsTableEp :: mode :- Summary " Table Ngrams API Change"
:> QueryParamR "ngramsType" TabType
:> QueryParamR "list" ListId
......@@ -89,7 +86,7 @@ data TableNgramsApiPut mode = TableNgramsApiPut
} deriving Generic
data RecomputeScoresNgramsApiGet mode = RecomputeScoresNgramsApiGet
newtype RecomputeScoresNgramsApiGet mode = RecomputeScoresNgramsApiGet
{ recomputeNgramsEp :: mode :- Summary " Recompute scores for ngrams table"
:> QueryParamR "ngramsType" TabType
:> QueryParamR "list" ListId
......@@ -97,7 +94,7 @@ data RecomputeScoresNgramsApiGet mode = RecomputeScoresNgramsApiGet
} deriving Generic
data TableNgramsApiGetVersion mode = TableNgramsApiGetVersion
newtype TableNgramsApiGetVersion mode = TableNgramsApiGetVersion
{ getTableNgramsVersion :: mode :- Summary " Table Ngrams API Get Version"
:> QueryParamR "ngramsType" TabType
:> QueryParamR "list" ListId
......@@ -110,32 +107,5 @@ data TableNgramsAsyncAPI mode = TableNgramsAsyncAPI
:> "async"
:> "charts"
:> "update"
:> AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] UpdateTableNgramsCharts JobLog)
} deriving Generic
data TableQuery = TableQuery
{ tq_offset :: Offset
, tq_limit :: Limit
, tq_orderBy :: OrderBy
, tq_view :: TabType
, tq_query :: RawQuery
} deriving Generic
type FacetTableResult = TableResult FacetDoc
--
-- instances
--
$(deriveJSON (unPrefix "tq_") ''TableQuery)
instance ToSchema TableQuery where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "tq_")
instance Arbitrary TableQuery where
arbitrary = elements [TableQuery { tq_offset = 0
, tq_limit = 10
, tq_orderBy = DateAsc
, tq_view = Docs
, tq_query = "electrodes" }]
......@@ -9,28 +9,26 @@ module Gargantext.API.Routes.Named.Viz (
, GraphAPI(..)
, GraphAsyncAPI(..)
, GraphVersionsAPI(..)
, PhyloExportAPI(..)
, PhyloExportEndpoints(..)
-- * API types (appears in the routes)
, PhyloData(..)
, GraphVersions(..)
) where
import Data.Aeson
import Data.Swagger
import Data.Aeson ( Value )
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types ( JobLog )
import Gargantext.API.Viz.Types (PhyloData(..))
import Gargantext.Core.Types
import Gargantext.Core.Types.Phylo
import Gargantext.Core.Viz.Graph.Types
import Gargantext.Core.Viz.LegacyPhylo (Level)
import Gargantext.Core.Viz.Phylo
import Gargantext.Core.Viz.Phylo.Legacy.LegacyMain (MinSizeBranch)
import Prelude
import Servant
import Servant.Job.Async (AsyncJobsAPI)
import Servant.XML.Conduit (XML)
import Test.QuickCheck
data PhyloAPI mode = PhyloAPI
......@@ -52,6 +50,8 @@ newtype PostPhylo mode = PostPhylo
} deriving Generic
-- | There is no Delete specific API for Graph since it can be deleted
-- as simple Node.
data GraphAPI mode = GraphAPI
{ getGraphEp :: mode :- Get '[JSON] HyperdataGraphAPI
, getGraphAsyncEp :: mode :- "async" :> NamedRoutes GraphAsyncAPI
......@@ -73,50 +73,11 @@ data GraphVersionsAPI mode = GraphVersionsAPI
, recomputeGraphVersionEp :: mode :- Summary "Recompute graph version" :> Post '[JSON] Graph
} deriving Generic
newtype PhyloExportAPI mode = PhyloExportAPI
{ phyloExportEndpoints :: mode :- "export" :> NamedRoutes PhyloExportEndpoints
} deriving Generic
data PhyloData = PhyloData { pd_corpusId :: NodeId
, pd_listId :: NodeId
, pd_data :: GraphData
, pd_config :: PhyloConfig
}
deriving (Generic, Show, Eq)
data GraphVersions = GraphVersions
{ gv_graph :: Maybe Int
, gv_repo :: Int
} deriving (Show, Generic)
--
-- instances
--
instance ToJSON PhyloData where
toJSON PhyloData{..} =
object [
"pd_corpusId" .= toJSON pd_corpusId
, "pd_listId" .= toJSON pd_listId
, "pd_data" .= toJSON pd_data
, "pd_config" .= toJSON pd_config
]
instance FromJSON PhyloData where
parseJSON = withObject "PhyloData" $ \o -> do
pd_corpusId <- o .: "pd_corpusId"
pd_listId <- o .: "pd_listId"
pd_data <- o .: "pd_data"
pd_config <- o .: "pd_config"
pure $ PhyloData{..}
instance Arbitrary PhyloData where
arbitrary = PhyloData <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
instance ToSchema PhyloData
instance FromJSON GraphVersions
instance ToJSON GraphVersions
instance ToSchema GraphVersions
data PhyloExportEndpoints mode = PhyloExportEndpoints
{ exportPhyloJSONEp :: mode :- "json" :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Value)
, exportPhyloDotEp :: mode :- "dot" :> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Text)
} deriving Generic
......@@ -5,12 +5,13 @@ module Gargantext.API.Routes.Types where
import Data.List qualified as L
import Data.Proxy
import Gargantext.API.Errors
import Network.Wai
import Prelude
import Servant.Client
import Servant.Ekg
import Servant.Server
import Servant.Server.Internal.DelayedIO
import Servant.Server.Internal.Delayed
import Network.Wai
import Servant.Server.Internal.DelayedIO
data WithCustomErrorScheme a
......@@ -30,3 +31,9 @@ instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx
instance HasEndpoint sub => HasEndpoint (WithCustomErrorScheme sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
instance HasClient m sub => HasClient m (WithCustomErrorScheme sub) where
type Client m (WithCustomErrorScheme sub) = GargErrorScheme -> Client m sub
clientWithRoute m _ req _mgr = clientWithRoute m (Proxy :: Proxy sub) req
hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
......@@ -19,47 +19,33 @@ Count API part of Gargantext.
module Gargantext.API.Search
where
import Data.Aeson hiding (defaultTaggedObject)
import Data.Swagger hiding (fieldLabelModifier, Contact)
import Data.Text qualified as T
import Gargantext.API.Prelude (GargServer)
import Gargantext.API.Prelude (IsGargServer)
import Gargantext.API.Routes.Named.Search qualified as Named
import Gargantext.API.Search.Types
import Gargantext.Core.Text.Corpus.Query (RawQuery (..), parseQuery)
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Core.Types.Search
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
import Gargantext.Database.Action.Search
import Gargantext.Database.Admin.Types.Node hiding (DEBUG)
import Gargantext.Database.Query.Facet
import Gargantext.Prelude
import Gargantext.System.Logging
import Gargantext.Utils.Aeson (defaultTaggedObject)
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
import Servant.Server.Generic (AsServerT)
-----------------------------------------------------------------------
-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
-- TODO-EVENTS: No event, this is a read-only query.
type API results = Summary "Search endpoint"
:> ReqBody '[JSON] SearchQuery
:> QueryParam "offset" Offset
:> QueryParam "limit" Limit
:> QueryParam "order" OrderBy
:> Post '[JSON] results
-----------------------------------------------------------------------
-- | Api search function
api :: NodeId -> GargServer (API SearchResult)
api nId (SearchQuery rawQuery SearchDoc) o l order = do
case parseQuery rawQuery of
api :: IsGargServer env err m => NodeId -> Named.SearchAPI SearchResult (AsServerT m)
api nId = Named.SearchAPI $ \query o l order -> case query of
(SearchQuery rawQuery SearchDoc) -> case parseQuery rawQuery of
Left err -> pure $ SearchResult $ SearchNoResult (T.pack err)
Right q -> do
$(logLocM) DEBUG $ T.pack "New search started with query = " <> (getRawQuery rawQuery)
SearchResult <$> SearchResultDoc
<$> map (toRow nId)
<$> searchInCorpus nId False q o l order
api nId (SearchQuery rawQuery SearchContact) o l order = do
case parseQuery rawQuery of
(SearchQuery rawQuery SearchContact) -> case parseQuery rawQuery of
Left err -> pure $ SearchResult $ SearchNoResult (T.pack err)
Right q -> do
-- printDebug "isPairedWith" nId
......@@ -72,81 +58,5 @@ api nId (SearchQuery rawQuery SearchContact) o l order = do
<$> SearchResultContact
<$> map (toRow aId)
<$> searchInCorpusWithContacts nId aId q o l order
api _nId (SearchQuery _q SearchDocWithNgrams) _o _l _order = undefined
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-- | Main Types
-----------------------------------------------------------------------
data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
deriving (Generic)
instance FromJSON SearchType where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchType where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema SearchType
instance Arbitrary SearchType where
arbitrary = elements [SearchDoc, SearchContact]
-----------------------------------------------------------------------
data SearchQuery =
SearchQuery { query :: !RawQuery
, expected :: !SearchType
}
deriving (Generic)
instance FromJSON SearchQuery where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchQuery where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchQuery
{-
where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
instance Arbitrary SearchQuery where
arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
-- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
-----------------------------------------------------------------------
data SearchResult =
SearchResult { result :: !SearchResultTypes}
deriving (Generic)
instance FromJSON SearchResult where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchResult where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchResult
{-
where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
instance Arbitrary SearchResult where
arbitrary = SearchResult <$> arbitrary
data SearchResultTypes =
SearchResultDoc { docs :: ![Row] }
| SearchResultContact { contacts :: ![Row] }
| SearchNoResult { message :: !Text }
deriving (Generic)
instance FromJSON SearchResultTypes where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance ToJSON SearchResultTypes where
toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance Arbitrary SearchResultTypes where
arbitrary = do
srd <- SearchResultDoc <$> arbitrary
src <- SearchResultContact <$> arbitrary
srn <- pure $ SearchNoResult "No result because.."
elements [srd, src, srn]
instance ToSchema SearchResultTypes where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
(SearchQuery _q SearchDocWithNgrams) -> panicTrace "unimplemented"
--------------------------------------------------------------------
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 "")
--------------------------------------------------------------------
{-|
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
......
{-# 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))
This diff is collapsed.
This diff is collapsed.
module Gargantext.API.Server.Named.Viz (
graphAPI
) where
import Gargantext.API.Admin.Auth (withNamedAccess)
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Prelude (GargM)
import Gargantext.API.Routes.Named.Viz qualified as Named
import Gargantext.Core.Viz.Graph.API
import Gargantext.Core.Viz.Graph.GEXF ()
-- (cooc2graph)
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude
import Servant.Server.Generic (AsServerT)
graphAPI :: AuthenticatedUser -> UserId -> NodeId -> Named.GraphAPI (AsServerT (GargM Env BackendInternalError))
graphAPI authenticatedUser userId n = withNamedAccess authenticatedUser (PathNode n) $ Named.GraphAPI
{ getGraphEp = getGraph n
, getGraphAsyncEp = graphAsync n
, cloneGraphEp = graphClone userId n
, gexfEp = getGraphGexf n
, graphVersionsAPI = graphVersionsAPI userId n
}
graphVersionsAPI :: UserId -> NodeId -> Named.GraphVersionsAPI (AsServerT (GargM Env BackendInternalError))
graphVersionsAPI u n = Named.GraphVersionsAPI
{ getGraphVersionsEp = graphVersions u n
, recomputeGraphVersionEp = recomputeVersions n
}
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -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
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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