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
-----------------------------------------------------------------------