[haskell-bee] update haskell-bee dep and other dependencies

parent b71620ea
Pipeline #7156 passed with stages
in 60 minutes and 10 seconds
...@@ -18,8 +18,8 @@ fi ...@@ -18,8 +18,8 @@ fi
# with the `sha256sum` result calculated on the `cabal.project` and # with the `sha256sum` result calculated on the `cabal.project` and
# `cabal.project.freeze`. This ensures the files stay deterministic so that CI # `cabal.project.freeze`. This ensures the files stay deterministic so that CI
# cache can kick in. # cache can kick in.
expected_cabal_project_hash="2b63b5dc1e026a27dcce7cb90080802a3a81f6f968d5edf8f913b8f0fd1203eb" expected_cabal_project_hash="118ab88c85b38aa740c0f7a23626262cf1d383c20fc8ca986a462259c519c7e7"
expected_cabal_project_freeze_hash="0d9d3d92afcaf2a1fbda3fa393a0990f72fc2ec766473aeecd669f7a5d805466" expected_cabal_project_freeze_hash="da270a3d058342dd52cdb44a6797518ef15029b204a8fc405a41e71c2c204071"
cabal --store-dir=$STORE_DIR v2-build --dry-run cabal --store-dir=$STORE_DIR v2-build --dry-run
......
...@@ -191,7 +191,10 @@ source-repository-package ...@@ -191,7 +191,10 @@ source-repository-package
source-repository-package source-repository-package
type: git type: git
location: https://gitlab.iscpif.fr/gargantext/haskell-bee location: https://gitlab.iscpif.fr/gargantext/haskell-bee
tag: d3c0b658aae5dedce04f4f1605e4a6605efebd31 tag: 69b7388a62f2afb5cb5609beac96e8cb35e94478
subdir: haskell-bee/
haskell-bee-pgmq/
haskell-bee-tests/
source-repository-package source-repository-package
type: git type: git
...@@ -210,21 +213,8 @@ allow-newer: ...@@ -210,21 +213,8 @@ allow-newer:
, accelerate-utility:accelerate , accelerate-utility:accelerate
, base:* , base:*
, crawlerHAL:servant , crawlerHAL:servant
-- , crawlerISTEX:servant
-- , crawlerPubMed:servant
-- , crawlerPubMed:servant-client-core
, iso639:aeson , iso639:aeson
, iso639:text , iso639:text
, morpheus-graphql-app:text
, morpheus-graphql-client:text
, morpheus-graphql-code-gen-utils:text
, morpheus-graphql-code-gen:text
, morpheus-graphql-core:text
, morpheus-graphql-server:text
, morpheus-graphql-subscriptions:text
, morpheus-graphql:text
, servant-client:servant
, servant-client:servant-client-core
, servant-ekg:base , servant-ekg:base
, servant-ekg:hashable , servant-ekg:hashable
, servant-ekg:servant , servant-ekg:servant
...@@ -236,8 +226,8 @@ allow-newer: ...@@ -236,8 +226,8 @@ allow-newer:
, stemmer:base , stemmer:base
allow-older: aeson:hashable allow-older: aeson:hashable
, crawlerHAL:servant-client , crawlerHAL:servant-client
, haskell-bee:postgresql-libpq
, haskell-bee:stm , haskell-bee:stm
, haskell-bee-tests:stm
, haskell-throttle:time , haskell-throttle:time
, hsparql:rdf4h , hsparql:rdf4h
......
...@@ -340,14 +340,6 @@ constraints: any.Boolean ==0.2.4, ...@@ -340,14 +340,6 @@ constraints: any.Boolean ==0.2.4,
any.monad-time ==0.4.0.0, any.monad-time ==0.4.0.0,
any.mono-traversable ==1.0.17.0, any.mono-traversable ==1.0.17.0,
any.monoid-extras ==0.6.3, any.monoid-extras ==0.6.3,
any.morpheus-graphql ==0.24.3,
any.morpheus-graphql-app ==0.24.3,
any.morpheus-graphql-client ==0.24.3,
any.morpheus-graphql-code-gen ==0.24.3,
any.morpheus-graphql-code-gen-utils ==0.24.3,
any.morpheus-graphql-core ==0.24.3,
any.morpheus-graphql-server ==0.24.3,
any.morpheus-graphql-subscriptions ==0.24.3,
any.mtl ==2.2.2, any.mtl ==2.2.2,
any.mtl-compat ==0.2.2, any.mtl-compat ==0.2.2,
mtl-compat -two-point-one -two-point-two, mtl-compat -two-point-one -two-point-two,
...@@ -365,7 +357,6 @@ constraints: any.Boolean ==0.2.4, ...@@ -365,7 +357,6 @@ constraints: any.Boolean ==0.2.4,
any.newtype-generics ==0.6.2, any.newtype-generics ==0.6.2,
any.old-locale ==1.0.0.7, any.old-locale ==1.0.0.7,
any.old-time ==1.1.0.4, any.old-time ==1.1.0.4,
any.opaleye ==0.9.7.0,
any.opaleye-textsearch ==0.2.0.0, any.opaleye-textsearch ==0.2.0.0,
any.openalex ==0.1.0.0, any.openalex ==0.1.0.0,
any.optics-core ==0.4.1.1, any.optics-core ==0.4.1.1,
...@@ -394,9 +385,7 @@ constraints: any.Boolean ==0.2.4, ...@@ -394,9 +385,7 @@ constraints: any.Boolean ==0.2.4,
any.polyparse ==1.13, any.polyparse ==1.13,
any.port-utils ==0.2.1.0, any.port-utils ==0.2.1.0,
any.postgres-options ==0.2.2.0, any.postgres-options ==0.2.2.0,
any.postgresql-libpq ==0.9.5.0,
postgresql-libpq -use-pkg-config, postgresql-libpq -use-pkg-config,
any.postgresql-simple ==0.6.5.1,
any.pretty ==1.1.3.6, any.pretty ==1.1.3.6,
any.pretty-show ==1.10, any.pretty-show ==1.10,
any.pretty-simple ==4.1.2.0, any.pretty-simple ==4.1.2.0,
...@@ -494,7 +483,6 @@ constraints: any.Boolean ==0.2.4, ...@@ -494,7 +483,6 @@ constraints: any.Boolean ==0.2.4,
splitmix -optimised-mixer, splitmix -optimised-mixer,
any.statistics ==0.16.2.1, any.statistics ==0.16.2.1,
any.stemmer ==0.5.2, any.stemmer ==0.5.2,
any.stm ==2.5.1.0,
any.stm-chans ==3.0.0.9, any.stm-chans ==3.0.0.9,
any.stm-containers ==1.2.1, any.stm-containers ==1.2.1,
any.stm-hamt ==1.2.1, any.stm-hamt ==1.2.1,
...@@ -586,7 +574,6 @@ constraints: any.Boolean ==0.2.4, ...@@ -586,7 +574,6 @@ constraints: any.Boolean ==0.2.4,
any.validity ==0.12.1.0, any.validity ==0.12.1.0,
any.vault ==0.3.1.5, any.vault ==0.3.1.5,
vault +useghc, vault +useghc,
any.vector ==0.12.3.1,
vector +boundschecks -internalchecks -unsafechecks -wall, vector +boundschecks -internalchecks -unsafechecks -wall,
any.vector-algorithms ==0.9.0.2, any.vector-algorithms ==0.9.0.2,
vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks, vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
......
...@@ -528,6 +528,7 @@ library ...@@ -528,6 +528,7 @@ library
, gargantext-prelude , gargantext-prelude
, graphviz ^>= 2999.20.1.0 , graphviz ^>= 2999.20.1.0
, haskell-bee , haskell-bee
, haskell-bee-pgmq
, haskell-igraph ^>= 0.10.4 , haskell-igraph ^>= 0.10.4
, haskell-pgmq >= 0.1.0.0 && < 0.2 , haskell-pgmq >= 0.1.0.0 && < 0.2
, haskell-throttle , haskell-throttle
...@@ -553,15 +554,15 @@ library ...@@ -553,15 +554,15 @@ library
, mime-mail >= 0.5.1 , mime-mail >= 0.5.1
, monad-control ^>= 1.0.3.1 , monad-control ^>= 1.0.3.1
, monad-logger ^>= 0.3.36 , monad-logger ^>= 0.3.36
, morpheus-graphql >= 0.24.3 && < 0.25 , morpheus-graphql >= 0.24.3 && < 0.28.1
, morpheus-graphql-app >= 0.24.3 && < 0.25 , morpheus-graphql-app >= 0.24.3 && < 0.28.1
, morpheus-graphql-server >= 0.24.3 && < 0.25 , morpheus-graphql-server >= 0.24.3 && < 0.28.1
, morpheus-graphql-subscriptions >= 0.24.3 && < 0.25 , morpheus-graphql-subscriptions >= 0.24.3 && < 0.28.1
, mtl ^>= 2.2.2 , mtl ^>= 2.2.2
, nanomsg-haskell >= 0.2.4 && < 0.3 , nanomsg-haskell >= 0.2.4 && < 0.3
, network >= 3.1.4.0 , network >= 3.1.4.0
, network-uri ^>= 2.6.4.1 , network-uri ^>= 2.6.4.1
, opaleye ^>= 0.9.6.1 , opaleye >= 0.9.6.1 && <= 0.10.3.1
, opaleye-textsearch >= 0.2.0.0 , opaleye-textsearch >= 0.2.0.0
, openalex , openalex
, openapi3 >= 3.2.3 , openapi3 >= 3.2.3
...@@ -569,7 +570,7 @@ library ...@@ -569,7 +570,7 @@ library
, parsec ^>= 3.1.16.1 , parsec ^>= 3.1.16.1
, patches-class ^>= 0.1.0.1 , patches-class ^>= 0.1.0.1
, patches-map ^>= 0.1.0.1 , patches-map ^>= 0.1.0.1
, postgresql-simple ^>= 0.6.4 , postgresql-simple >= 0.6.4 && <= 0.7.0.0
, process ^>= 1.6.18.0 , process ^>= 1.6.18.0
, product-profunctors ^>= 0.11.0.3 , product-profunctors ^>= 0.11.0.3
, protolude ^>= 0.3.3 , protolude ^>= 0.3.3
...@@ -625,7 +626,7 @@ library ...@@ -625,7 +626,7 @@ library
, utf8-string ^>= 1.0.2 , utf8-string ^>= 1.0.2
, uuid ^>= 1.3.15 , uuid ^>= 1.3.15
, validity ^>= 0.12.0.2 , validity ^>= 0.12.0.2
, vector ^>= 0.12.3.0 , vector >= 0.12.3.0 && <= 0.13.1.0
, wai >= 3.2.4 , wai >= 3.2.4
, wai-cors ^>= 0.2.7 , wai-cors ^>= 0.2.7
, wai-extra ^>= 3.1.8 , wai-extra ^>= 3.1.8
...@@ -677,6 +678,7 @@ executable gargantext ...@@ -677,6 +678,7 @@ executable gargantext
, gargantext , gargantext
, gargantext-prelude , gargantext-prelude
, haskell-bee , haskell-bee
, haskell-bee-pgmq
, ini ^>= 0.4.1 , ini ^>= 0.4.1
, lens >= 5.2.2 && < 5.3 , lens >= 5.2.2 && < 5.3
, MonadRandom ^>= 0.6 , MonadRandom ^>= 0.6
...@@ -684,7 +686,7 @@ executable gargantext ...@@ -684,7 +686,7 @@ executable gargantext
, optparse-applicative , optparse-applicative
, optparse-generic ^>= 1.4.7 , optparse-generic ^>= 1.4.7
, parallel ^>= 3.2.2.0 , parallel ^>= 3.2.2.0
, postgresql-simple ^>= 0.6.4 , postgresql-simple >= 0.6.4 && <= 0.7.0.0
, protolude ^>= 0.3.3 , protolude ^>= 0.3.3
, servant >= 0.20.1 && < 0.21 , servant >= 0.20.1 && < 0.21
, servant-auth , servant-auth
...@@ -698,7 +700,7 @@ executable gargantext ...@@ -698,7 +700,7 @@ executable gargantext
, toml-parser >= 2.0.1.0 && < 3 , toml-parser >= 2.0.1.0 && < 3
, tree-diff , tree-diff
, unordered-containers ^>= 0.2.16.0 , unordered-containers ^>= 0.2.16.0
, vector ^>= 0.12.3.0 , vector >= 0.12.3.0 && <= 0.13.1.0
ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fprint-potential-instances ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wmissing-signatures -Wunused-binds -Wunused-imports -Werror -freduction-depth=300 -fprint-potential-instances
common testDependencies common testDependencies
...@@ -728,6 +730,7 @@ common testDependencies ...@@ -728,6 +730,7 @@ common testDependencies
, generic-arbitrary >= 1.0.1 && < 2 , generic-arbitrary >= 1.0.1 && < 2
, graphviz ^>= 2999.20.1.0 , graphviz ^>= 2999.20.1.0
, haskell-bee , haskell-bee
, haskell-bee-pgmq
, hspec ^>= 2.11.1 , hspec ^>= 2.11.1
, hspec-core , hspec-core
, hspec-expectations >= 0.8 && < 0.9 , hspec-expectations >= 0.8 && < 0.9
...@@ -747,7 +750,7 @@ common testDependencies ...@@ -747,7 +750,7 @@ common testDependencies
, patches-class ^>= 0.1.0.1 , patches-class ^>= 0.1.0.1
, patches-map ^>= 0.1.0.1 , patches-map ^>= 0.1.0.1
, postgres-options >= 0.2 && < 0.3 , postgres-options >= 0.2 && < 0.3
, postgresql-simple >= 0.6.4 && < 0.7 , postgresql-simple >= 0.6.4 && <= 0.7.0.0
, pretty ^>= 1.1.3.6 , pretty ^>= 1.1.3.6
, process ^>= 1.6.18.0 , process ^>= 1.6.18.0
, protolude ^>= 0.3.3 , protolude ^>= 0.3.3
...@@ -783,7 +786,7 @@ common testDependencies ...@@ -783,7 +786,7 @@ common testDependencies
, unordered-containers ^>= 0.2.16.0 , unordered-containers ^>= 0.2.16.0
, utf8-string ^>= 1.0.2 , utf8-string ^>= 1.0.2
, validity ^>= 0.12.0.2 , validity ^>= 0.12.0.2
, vector ^>= 0.12.3.0 , vector >= 0.12.3.0 && <= 0.13.1.0
, wai , wai
, wai-extra , wai-extra
, warp , warp
......
...@@ -18,11 +18,12 @@ module Gargantext.API.Admin.Orchestrator.Types ...@@ -18,11 +18,12 @@ module Gargantext.API.Admin.Orchestrator.Types
where where
import Data.Aeson (genericParseJSON, genericToJSON) import Data.Aeson (genericParseJSON, genericToJSON)
import Data.Morpheus.Types ( GQLType, typeOptions ) import Data.Morpheus.Types ( GQLType, VisitType(visitFieldNames) )
import Data.Swagger (ToSchema, URL, declareNamedSchema, defaultSchemaOptions, genericDeclareNamedSchemaUnrestricted) import Data.Swagger (ToSchema, URL, declareNamedSchema, defaultSchemaOptions, genericDeclareNamedSchemaUnrestricted)
import Gargantext.API.GraphQL.UnPrefix qualified as GQLU -- import Gargantext.API.GraphQL.UnPrefix qualified as GQLU
import Gargantext.Core.Types (TODO(..)) import Gargantext.Core.Types (TODO(..))
import Gargantext.Core.Utils.Aeson (jsonOptions) import Gargantext.Core.Utils.Aeson (jsonOptions)
import Gargantext.Core.Utils.Prefix (dropPrefixT)
import Gargantext.Prelude import Gargantext.Prelude
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary
...@@ -74,8 +75,9 @@ instance ToJSON ScraperEvent where ...@@ -74,8 +75,9 @@ instance ToJSON ScraperEvent where
instance FromJSON ScraperEvent where instance FromJSON ScraperEvent where
parseJSON = genericParseJSON $ jsonOptions "_scev_" parseJSON = genericParseJSON $ jsonOptions "_scev_"
instance ToSchema ScraperEvent -- TODO _scev_ prefix instance ToSchema ScraperEvent -- TODO _scev_ prefix
instance GQLType ScraperEvent where instance GQLType ScraperEvent
typeOptions _ = GQLU.unPrefix "_scev_" instance VisitType ScraperEvent where
visitFieldNames _ = dropPrefixT "_scev_"
data JobLog = JobLog data JobLog = JobLog
...@@ -102,6 +104,7 @@ instance ToJSON JobLog where ...@@ -102,6 +104,7 @@ instance ToJSON JobLog where
instance FromJSON JobLog where instance FromJSON JobLog where
parseJSON = genericParseJSON $ jsonOptions "_scst_" parseJSON = genericParseJSON $ jsonOptions "_scst_"
instance ToSchema JobLog -- TODO _scst_ prefix instance ToSchema JobLog -- TODO _scst_ prefix
instance GQLType JobLog where instance GQLType JobLog
typeOptions _ = GQLU.unPrefix "_scst_" -- typeOptions _ = GQLU.unPrefix "_scst_"
instance VisitType JobLog where
visitFieldNames _ = dropPrefixT "_scst_"
...@@ -12,12 +12,12 @@ Portability : POSIX ...@@ -12,12 +12,12 @@ Portability : POSIX
module Gargantext.API.GraphQL.UnPrefix where module Gargantext.API.GraphQL.UnPrefix where
import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier) -- import Data.Morpheus.Types (GQLTypeOptions, fieldLabelModifier)
import Data.Text qualified as T -- import Data.Text qualified as T
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix) -- import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Prelude -- import Gargantext.Prelude
unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions -- unPrefix :: T.Text -> GQLTypeOptions -> GQLTypeOptions
unPrefix prefix options = options { fieldLabelModifier = nflm } -- unPrefix prefix options = options { fieldLabelModifier = nflm }
where -- where
nflm label = unCapitalize $ dropPrefix (T.unpack prefix) $ ( fieldLabelModifier options ) label -- nflm label = unCapitalize $ dropPrefix (T.unpack prefix) $ ( fieldLabelModifier options ) label
...@@ -15,7 +15,7 @@ Portability : POSIX ...@@ -15,7 +15,7 @@ Portability : POSIX
module Gargantext.API.GraphQL.UserInfo where module Gargantext.API.GraphQL.UserInfo where
import Control.Lens import Control.Lens
import Data.Morpheus.Types ( GQLType, description ) import Data.Morpheus.Types ( GQLType, VisitType(visitTypeDescription) )
import Data.Text qualified as T import Data.Text qualified as T
import Gargantext.Database.Admin.Types.Hyperdata import Gargantext.Database.Admin.Types.Hyperdata
( HyperdataUser(..) ( HyperdataUser(..)
...@@ -75,8 +75,9 @@ data UserInfo = UserInfo ...@@ -75,8 +75,9 @@ data UserInfo = UserInfo
, ui_cwDescription :: Maybe Text , ui_cwDescription :: Maybe Text
} }
deriving (Generic, Show) deriving (Generic, Show)
instance GQLType UserInfo where instance GQLType UserInfo
description = const $ Just "provides user info" instance VisitType UserInfo where
visitTypeDescription _ = const $ Just "provides user info"
-- | Arguments to the "user info" query. -- | Arguments to the "user info" query.
data UserInfoArgs data UserInfoArgs
......
...@@ -19,6 +19,7 @@ module Gargantext.Core.Types.Individu ...@@ -19,6 +19,7 @@ module Gargantext.Core.Types.Individu
where where
import Data.Aeson import Data.Aeson
import Data.Morpheus.Types (GQLType)
import Data.Swagger import Data.Swagger
import Data.Text (pack, reverse) import Data.Text (pack, reverse)
import Data.Text qualified as T import Data.Text qualified as T
...@@ -45,6 +46,7 @@ type Username = Text ...@@ -45,6 +46,7 @@ type Username = Text
type HashPassword = Auth.PasswordHash Auth.Argon2 type HashPassword = Auth.PasswordHash Auth.Argon2
newtype GargPassword = GargPassword Text newtype GargPassword = GargPassword Text
deriving (Generic) deriving (Generic)
instance GQLType GargPassword
toGargPassword :: Text -> GargPassword toGargPassword :: Text -> GargPassword
toGargPassword x = GargPassword x toGargPassword x = GargPassword x
......
...@@ -16,13 +16,14 @@ module Gargantext.Core.Utils.Prefix ...@@ -16,13 +16,14 @@ module Gargantext.Core.Utils.Prefix
( module Gargantext.Core.Utils.Prefix ( module Gargantext.Core.Utils.Prefix
) where ) where
import Prelude
import Data.Aeson (Value, defaultOptions, parseJSON) import Data.Aeson (Value, defaultOptions, parseJSON)
import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields, sumEncoding, SumEncoding(UntaggedValue)) import Data.Aeson.TH (Options, fieldLabelModifier, omitNothingFields, sumEncoding, SumEncoding(UntaggedValue))
import Data.Aeson.Types (Parser) import Data.Aeson.Types (Parser)
import Data.Char (toLower) import Data.Char (toLower)
import Data.Maybe (fromMaybe)
import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions) import Data.Swagger.SchemaOptions (SchemaOptions, fromAesonOptions)
import Data.Text qualified as T
import Prelude
import Text.Read (readMaybe) import Text.Read (readMaybe)
...@@ -64,3 +65,6 @@ parseJSONFromString v = do ...@@ -64,3 +65,6 @@ parseJSONFromString v = do
case readMaybe (numString :: String) of case readMaybe (numString :: String) of
Nothing -> fail $ "Invalid number for TransactionID: " ++ show v -- TODO error message too specific Nothing -> fail $ "Invalid number for TransactionID: " ++ show v -- TODO error message too specific
Just n -> pure n Just n -> pure n
dropPrefixT :: T.Text -> T.Text -> T.Text
dropPrefixT prefix input = fromMaybe input (T.stripPrefix prefix input)
...@@ -19,10 +19,10 @@ Portability : POSIX ...@@ -19,10 +19,10 @@ Portability : POSIX
module Gargantext.Database.Admin.Types.Hyperdata.Contact module Gargantext.Database.Admin.Types.Hyperdata.Contact
where where
import Data.Morpheus.Types (GQLType(..)) import Data.Morpheus.Types (GQLType, VisitType(visitFieldNames))
import Data.Time.Segment (jour) import Data.Time.Segment (jour)
import Gargantext.API.GraphQL.UnPrefix qualified as GAGU
import Gargantext.Core.Text (HasText(..)) import Gargantext.Core.Text (HasText(..))
import Gargantext.Core.Utils.Prefix (dropPrefixT)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude import Gargantext.Database.Admin.Types.Hyperdata.Prelude
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Utils.UTCTime ( NUTCTime(..) ) import Gargantext.Utils.UTCTime ( NUTCTime(..) )
...@@ -37,8 +37,9 @@ data HyperdataContact = ...@@ -37,8 +37,9 @@ data HyperdataContact =
, _hc_lastValidation :: Maybe Text -- TODO UTCTime , _hc_lastValidation :: Maybe Text -- TODO UTCTime
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
instance GQLType HyperdataContact where instance GQLType HyperdataContact
typeOptions _ = GAGU.unPrefix "_hc_" instance VisitType HyperdataContact where
visitFieldNames _ = dropPrefixT "_hc_"
instance HasText HyperdataContact instance HasText HyperdataContact
where where
...@@ -93,8 +94,9 @@ data ContactWho = ...@@ -93,8 +94,9 @@ data ContactWho =
, _cw_description :: Maybe Text , _cw_description :: Maybe Text
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
instance GQLType ContactWho where instance GQLType ContactWho
typeOptions _ = GAGU.unPrefix "_cw_" instance VisitType ContactWho where
visitFieldNames _ = dropPrefixT "_cw_"
type FirstName = Text type FirstName = Text
type LastName = Text type LastName = Text
...@@ -127,8 +129,9 @@ data ContactWhere = ...@@ -127,8 +129,9 @@ data ContactWhere =
, _cw_exit :: Maybe NUTCTime , _cw_exit :: Maybe NUTCTime
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
instance GQLType ContactWhere where instance GQLType ContactWhere
typeOptions _ = GAGU.unPrefix "_cw_" instance VisitType ContactWhere where
visitFieldNames _ = dropPrefixT "_cw_"
defaultContactWhere :: ContactWhere defaultContactWhere :: ContactWhere
defaultContactWhere = defaultContactWhere =
...@@ -149,8 +152,9 @@ data ContactTouch = ...@@ -149,8 +152,9 @@ data ContactTouch =
, _ct_url :: Maybe Text , _ct_url :: Maybe Text
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
instance GQLType ContactTouch where instance GQLType ContactTouch
typeOptions _ = GAGU.unPrefix "_ct_" instance VisitType ContactTouch where
visitFieldNames _ = dropPrefixT "_ct_"
defaultContactTouch :: ContactTouch defaultContactTouch :: ContactTouch
defaultContactTouch = defaultContactTouch =
......
...@@ -18,9 +18,9 @@ Portability : POSIX ...@@ -18,9 +18,9 @@ Portability : POSIX
module Gargantext.Database.Admin.Types.Hyperdata.User module Gargantext.Database.Admin.Types.Hyperdata.User
where where
import Data.Morpheus.Types (GQLType(typeOptions)) import Data.Morpheus.Types (GQLType, VisitType(visitFieldNames))
import qualified Gargantext.API.GraphQL.UnPrefix as GAGU
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Core.Utils.Prefix (dropPrefixT)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude import Gargantext.Database.Admin.Types.Hyperdata.Prelude
import Gargantext.Database.Admin.Types.Hyperdata.Contact import Gargantext.Database.Admin.Types.Hyperdata.Contact
import Gargantext.Database.Admin.Types.Node (DocumentId) import Gargantext.Database.Admin.Types.Node (DocumentId)
...@@ -38,17 +38,20 @@ data HyperdataUser = ...@@ -38,17 +38,20 @@ data HyperdataUser =
, _hu_epo_api_token :: !(Maybe Text) , _hu_epo_api_token :: !(Maybe Text)
} deriving (Eq, Show, Generic) } deriving (Eq, Show, Generic)
instance GQLType HyperdataUser where instance GQLType HyperdataUser
typeOptions _ = GAGU.unPrefix "_hu_" instance VisitType HyperdataUser where
visitFieldNames _ = dropPrefixT "_hu_"
data HyperdataPrivate = data HyperdataPrivate =
HyperdataPrivate { _hpr_password :: !Text HyperdataPrivate { _hpr_password :: !Text
, _hpr_lang :: !Lang , _hpr_lang :: !Lang
} }
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic, GQLType)
instance GQLType HyperdataPrivate where -- instance GQLType HyperdataPrivate where
typeOptions _ = GAGU.unPrefix "_hpr_" -- typeOptions _ = GAGU.unPrefix "_hpr_"
instance VisitType HyperdataPrivate where
visitFieldNames _ = dropPrefixT "_hpr_"
data HyperdataPublic = data HyperdataPublic =
...@@ -57,8 +60,9 @@ data HyperdataPublic = ...@@ -57,8 +60,9 @@ data HyperdataPublic =
} }
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
instance GQLType HyperdataPublic where instance GQLType HyperdataPublic
typeOptions _ = GAGU.unPrefix "_hpu_" instance VisitType HyperdataPublic where
visitFieldNames _ = dropPrefixT "_hpu_"
-- | Default -- | Default
defaultHyperdataUser :: HyperdataUser defaultHyperdataUser :: HyperdataUser
......
...@@ -32,7 +32,7 @@ module Gargantext.Database.Query.Join ( leftJoin2 ...@@ -32,7 +32,7 @@ module Gargantext.Database.Query.Join ( leftJoin2
import Control.Arrow ((>>>), returnA) import Control.Arrow ((>>>), returnA)
import Data.Profunctor.Product.Default ( Default ) import Data.Profunctor.Product.Default ( Default )
import Gargantext.Prelude ( Applicative((<*>)), (<$>) ) import Gargantext.Prelude ( Applicative((<*>)), (<$>) )
import Opaleye hiding (keepWhen) import Opaleye
import Opaleye.Internal.Join (NullMaker(..)) import Opaleye.Internal.Join (NullMaker(..))
......
...@@ -41,10 +41,10 @@ insertContextNodeNgrams = insertContextNodeNgramsW ...@@ -41,10 +41,10 @@ insertContextNodeNgrams = insertContextNodeNgramsW
insertContextNodeNgramsW :: [ContextNodeNgramsWrite] -> DBCmd err Int insertContextNodeNgramsW :: [ContextNodeNgramsWrite] -> DBCmd err Int
insertContextNodeNgramsW nnnw = insertContextNodeNgramsW nnnw =
mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing mkCmd $ \c -> fromIntegral <$> runInsert c insertNothing
where where
insertNothing = Insert { iTable = contextNodeNgramsTable insertNothing = Insert { iTable = contextNodeNgramsTable
, iRows = nnnw , iRows = nnnw
, iReturning = rCount , iReturning = rCount
, iOnConflict = Just DoNothing , iOnConflict = Just doNothing
} }
...@@ -37,10 +37,10 @@ insertContextNodeNgrams2 = insertContextNodeNgrams2W ...@@ -37,10 +37,10 @@ insertContextNodeNgrams2 = insertContextNodeNgrams2W
insertContextNodeNgrams2W :: [ContextNodeNgrams2Write] -> DBCmd err Int insertContextNodeNgrams2W :: [ContextNodeNgrams2Write] -> DBCmd err Int
insertContextNodeNgrams2W nnnw = insertContextNodeNgrams2W nnnw =
mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing mkCmd $ \c -> fromIntegral <$> runInsert c insertNothing
where where
insertNothing = Insert { iTable = contextNodeNgrams2Table insertNothing = Insert { iTable = contextNodeNgrams2Table
, iRows = nnnw , iRows = nnnw
, iReturning = rCount , iReturning = rCount
, iOnConflict = (Just DoNothing) , iOnConflict = (Just doNothing)
} }
...@@ -130,7 +130,7 @@ selectNodesWith' parentId maybeNodeType = proc () -> do ...@@ -130,7 +130,7 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
deleteNode :: NodeId -> DBCmd err Int deleteNode :: NodeId -> DBCmd err Int
deleteNode n = mkCmd $ \conn -> deleteNode n = mkCmd $ \conn ->
fromIntegral <$> runDelete_ conn fromIntegral <$> runDelete conn
(Delete nodeTable (Delete nodeTable
(\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n) (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
rCount rCount
...@@ -138,7 +138,7 @@ deleteNode n = mkCmd $ \conn -> ...@@ -138,7 +138,7 @@ deleteNode n = mkCmd $ \conn ->
deleteNodes :: [NodeId] -> DBCmd err Int deleteNodes :: [NodeId] -> DBCmd err Int
deleteNodes ns = mkCmd $ \conn -> deleteNodes ns = mkCmd $ \conn ->
fromIntegral <$> runDelete_ conn fromIntegral <$> runDelete conn
(Delete nodeTable (Delete nodeTable
(\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id) (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
rCount rCount
...@@ -380,7 +380,7 @@ node nodeType name hyperData parentId userId = ...@@ -380,7 +380,7 @@ node nodeType name hyperData parentId userId =
------------------------------- -------------------------------
insertNodesR :: [NodeWrite] -> DBCmd err [NodeId] insertNodesR :: [NodeWrite] -> DBCmd err [NodeId]
insertNodesR ns = mkCmd $ \conn -> insertNodesR ns = mkCmd $ \conn ->
runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _ _) -> i)) Nothing) runInsert conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _ _) -> i)) Nothing)
insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> DBCmd err [NodeId] insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> DBCmd err [NodeId]
insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> pid) <$> ns) insertNodesWithParentR pid ns = insertNodesR (set node_parent_id (pgNodeId <$> pid) <$> ns)
......
...@@ -31,7 +31,7 @@ updateHyperdata i h = do ...@@ -31,7 +31,7 @@ updateHyperdata i h = do
mkCmd $ \c -> do mkCmd $ \c -> do
-- res <- withLogger () $ \ioLogger -> do -- res <- withLogger () $ \ioLogger -> do
-- logMsg ioLogger DEBUG "[updateHyperdata] before runUpdate_" -- logMsg ioLogger DEBUG "[updateHyperdata] before runUpdate_"
res <- runUpdate_ c $ updateHyperdataQuery i h res <- runUpdate c $ updateHyperdataQuery i h
-- logMsg ioLogger DEBUG $ "[updateHyperdata] after runUpdate_: " <> show res -- logMsg ioLogger DEBUG $ "[updateHyperdata] after runUpdate_: " <> show res
pure res pure res
-- withLogger () $ \ioLogger -> do -- withLogger () $ \ioLogger -> do
......
...@@ -299,8 +299,8 @@ getContextNgramsMatchingFTS contextId listId = do ...@@ -299,8 +299,8 @@ getContextNgramsMatchingFTS contextId listId = do
OR contexts.search @@ plainto_tsquery('french', ngrams.terms)) |] OR contexts.search @@ plainto_tsquery('french', ngrams.terms)) |]
------------------------------------------------------------------------ ------------------------------------------------------------------------
insertNodeContext :: [NodeContext] -> DBCmd err Int insertNodeContext :: [NodeContext] -> DBCmd err Int
insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert conn
$ Insert nodeContextTable ns' rCount (Just DoNothing)) $ Insert nodeContextTable ns' rCount (Just doNothing))
where where
ns' :: [NodeContextWrite] ns' :: [NodeContextWrite]
ns' = map (\(NodeContext i n c x y) ns' = map (\(NodeContext i n c x y)
...@@ -318,7 +318,7 @@ type Context_Id = NodeId ...@@ -318,7 +318,7 @@ type Context_Id = NodeId
deleteNodeContext :: Node_Id -> Context_Id -> DBCmd err Int deleteNodeContext :: Node_Id -> Context_Id -> DBCmd err Int
deleteNodeContext n c = mkCmd $ \conn -> deleteNodeContext n c = mkCmd $ \conn ->
fromIntegral <$> runDelete_ conn fromIntegral <$> runDelete conn
(Delete nodeContextTable (Delete nodeContextTable
(\(NodeContext _ n_id c_id _ _) -> n_id .== pgNodeId n (\(NodeContext _ n_id c_id _ _) -> n_id .== pgNodeId n
.&& c_id .== pgNodeId c .&& c_id .== pgNodeId c
......
...@@ -127,8 +127,8 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query ...@@ -127,8 +127,8 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
-- the share being created is valid. Use the other functions like -- the share being created is valid. Use the other functions like
-- 'shareNode', 'publishNode', or roll your own. -- 'shareNode', 'publishNode', or roll your own.
insertNodeNode :: [NodeNode] -> DBCmd err Int insertNodeNode :: [NodeNode] -> DBCmd err Int
insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert conn
$ Insert nodeNodeTable ns' rCount (Just DoNothing)) $ Insert nodeNodeTable ns' rCount (Just doNothing))
where where
ns' :: [NodeNodeWrite] ns' :: [NodeNodeWrite]
ns' = map (\(NodeNode n1 n2 x y) ns' = map (\(NodeNode n1 n2 x y)
...@@ -146,7 +146,7 @@ type Node2_Id = NodeId ...@@ -146,7 +146,7 @@ type Node2_Id = NodeId
deleteNodeNode :: Node1_Id -> Node2_Id -> DBCmd err Int deleteNodeNode :: Node1_Id -> Node2_Id -> DBCmd err Int
deleteNodeNode n1 n2 = mkCmd $ \conn -> deleteNodeNode n1 n2 = mkCmd $ \conn ->
fromIntegral <$> runDelete_ conn fromIntegral <$> runDelete conn
(Delete nodeNodeTable (Delete nodeNodeTable
(\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1 (\(NodeNode n1_id n2_id _ _) -> n1_id .== pgNodeId n1
.&& n2_id .== pgNodeId n2 .&& n2_id .== pgNodeId n2
......
...@@ -19,12 +19,12 @@ Functions to deal with users, database side. ...@@ -19,12 +19,12 @@ Functions to deal with users, database side.
module Gargantext.Database.Schema.User where module Gargantext.Database.Schema.User where
import Data.Morpheus.Types (GQLType(typeOptions)) import Data.Morpheus.Types (GQLType, VisitType(visitFieldNames))
import Data.Time (UTCTime) import Data.Time (UTCTime)
import Database.PostgreSQL.Simple.FromField (FromField, fromField) import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import Gargantext.API.GraphQL.UnPrefix qualified as GAGU -- import Gargantext.API.GraphQL.UnPrefix qualified as GAGU
import Gargantext.Core.Types.Individu (GargPassword, toGargPassword) import Gargantext.Core.Types.Individu (GargPassword, toGargPassword)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix, dropPrefixT)
import Gargantext.Database.Prelude (fromField') import Gargantext.Database.Prelude (fromField')
import Gargantext.Prelude import Gargantext.Prelude
...@@ -44,8 +44,9 @@ data UserLight = UserLight { userLight_id :: !UserId ...@@ -44,8 +44,9 @@ data UserLight = UserLight { userLight_id :: !UserId
, userLight_password :: !GargPassword , userLight_password :: !GargPassword
, userLight_forgot_password_uuid :: !(Maybe Text) , userLight_forgot_password_uuid :: !(Maybe Text)
} deriving (Show, Generic) } deriving (Show, Generic)
instance GQLType UserLight where instance GQLType UserLight
typeOptions _ = GAGU.unPrefix "userLight_" instance VisitType UserLight where
visitFieldNames _ = dropPrefixT "userLight_"
toUserLight :: UserDB -> UserLight toUserLight :: UserDB -> UserLight
toUserLight (UserDB { user_id toUserLight (UserDB { user_id
......
...@@ -71,26 +71,31 @@ ...@@ -71,26 +71,31 @@
- "microlens-th-0.4.3.15" - "microlens-th-0.4.3.15"
- "mono-traversable-1.0.17.0" - "mono-traversable-1.0.17.0"
- "monoid-extras-0.6.3" - "monoid-extras-0.6.3"
- "morpheus-graphql-0.24.3" - "morpheus-graphql-0.28.0"
- "morpheus-graphql-app-0.24.3" - "morpheus-graphql-app-0.28.0"
- "morpheus-graphql-client-0.24.3" - "morpheus-graphql-client-0.28.1"
- "morpheus-graphql-code-gen-0.24.3" - "morpheus-graphql-code-gen-0.28.1"
- "morpheus-graphql-code-gen-utils-0.24.3" - "morpheus-graphql-code-gen-utils-0.28.1"
- "morpheus-graphql-core-0.24.3" - "morpheus-graphql-core-0.28.1"
- "morpheus-graphql-server-0.24.3" - "morpheus-graphql-server-0.28.0"
- "morpheus-graphql-subscriptions-0.24.3" - "morpheus-graphql-subscriptions-0.28.0"
- "mwc-random-0.15.1.0" - "mwc-random-0.15.1.0"
- "network-control-0.0.2" - "network-control-0.0.2"
- "opaleye-0.10.3.1"
- "ordered-containers-0.2.4" - "ordered-containers-0.2.4"
- "os-string-2.0.6" - "os-string-2.0.6"
- "password-3.0.4.0" - "password-3.0.4.0"
- "postgres-options-0.2.2.0" - "postgres-options-0.2.2.0"
- "postgresql-libpq-0.10.2.0"
- "postgresql-libpq-configure-0.10.0.1"
- "postgresql-simple-0.7.0.0"
- "primitive-0.7.4.0" - "primitive-0.7.4.0"
- "primitive-extras-0.10.2" - "primitive-extras-0.10.2"
- "primitive-unlifted-2.1.0.0" - "primitive-unlifted-2.1.0.0"
- "protolude-0.3.4" - "protolude-0.3.4"
- "rake-0.0.1" - "rake-0.0.1"
- "random-1.2.1.2" - "random-1.2.1.2"
- "random-strings-0.1.1.0"
- "recover-rtti-0.4.3" - "recover-rtti-0.4.3"
- "reflection-2.1.8" - "reflection-2.1.8"
- "resourcet-1.3.0" - "resourcet-1.3.0"
...@@ -137,8 +142,8 @@ ...@@ -137,8 +142,8 @@
- "uuid-1.3.16" - "uuid-1.3.16"
- "uuid-types-1.0.6" - "uuid-types-1.0.6"
- "validity-0.12.1.0" - "validity-0.12.1.0"
- "vector-0.12.3.1"
- "vector-algorithms-0.9.0.2" - "vector-algorithms-0.9.0.2"
- "vector-stream-0.1.0.1"
- "wai-app-static-3.1.9" - "wai-app-static-3.1.9"
- "wai-extra-3.1.15" - "wai-extra-3.1.15"
- "wai-logger-2.4.1" - "wai-logger-2.4.1"
...@@ -256,10 +261,18 @@ ...@@ -256,10 +261,18 @@
git: "https://gitlab.iscpif.fr/gargantext/gargantext-graph.git" git: "https://gitlab.iscpif.fr/gargantext/gargantext-graph.git"
subdirs: subdirs:
- . - .
- commit: d3c0b658aae5dedce04f4f1605e4a6605efebd31 - commit: 69b7388a62f2afb5cb5609beac96e8cb35e94478
git: "https://gitlab.iscpif.fr/gargantext/haskell-bee" git: "https://gitlab.iscpif.fr/gargantext/haskell-bee"
subdirs: subdirs:
- . - "haskell-bee-pgmq/"
- commit: 69b7388a62f2afb5cb5609beac96e8cb35e94478
git: "https://gitlab.iscpif.fr/gargantext/haskell-bee"
subdirs:
- "haskell-bee-tests/"
- commit: 69b7388a62f2afb5cb5609beac96e8cb35e94478
git: "https://gitlab.iscpif.fr/gargantext/haskell-bee"
subdirs:
- "haskell-bee/"
- commit: bb15d828d5ef36eeaa84cccb00598b585048c88e - commit: bb15d828d5ef36eeaa84cccb00598b585048c88e
git: "https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude" git: "https://gitlab.iscpif.fr/gargantext/haskell-gargantext-prelude"
subdirs: subdirs:
......
...@@ -27,7 +27,7 @@ tests = describe "Microservices proxy" $ do ...@@ -27,7 +27,7 @@ tests = describe "Microservices proxy" $ do
writeFrameTests writeFrameTests
writeFrameTests :: Spec writeFrameTests :: Spec
writeFrameTests = parallel $ aroundAll withBackendServerAndProxy $ beforeAllWith (\ctx@(testEnv, _, _) -> setupEnvironment testEnv >>= (const $ pure ctx)) $ do writeFrameTests = sequential $ aroundAll withBackendServerAndProxy $ beforeAllWith (\ctx@(testEnv, _, _) -> setupEnvironment testEnv >>= (const $ pure ctx)) $ do
describe "Write Frame Reverse Proxy" $ do describe "Write Frame Reverse Proxy" $ do
it "should disallow unauthenticated requests" $ \(_testEnv, _serverPort, proxyPort) -> do it "should disallow unauthenticated requests" $ \(_testEnv, _serverPort, proxyPort) -> do
baseUrl <- parseBaseUrl "http://localhost" baseUrl <- parseBaseUrl "http://localhost"
......
...@@ -57,7 +57,7 @@ main = do ...@@ -57,7 +57,7 @@ main = do
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering
-- TODO Ideally remove start/stop notifications and use -- TODO Ideally remove start/stop notifications and use
-- Test/API/Setup to initialize this in env -- Test/API/Setup to initialize this in env
bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ do bracket startCoreNLPServer stopCoreNLPServer $ \_ -> hspec $ sequential $ do
API.tests API.tests
ReverseProxy.tests ReverseProxy.tests
DB.tests DB.tests
......
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