Merge branch '421-refactor-gargantext-database-prelude' into 'dev'

Resolve "Refactor `Gargantext.Database.Prelude`"

Closes #421

See merge request !372

bin/gargantext-cli/CLI/Admin.hs

@@ -21,7 +21,7 @@ import Prelude (String)
 adminCLI :: AdminArgs -> IO ()
 adminCLI (AdminArgs settingsPath mails) = do
   withDevEnv settingsPath $ \env -> do
-    x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: Cmd'' DevEnv BackendInternalError (NonEmpty UserId))
+    x <- runCmdDev env ((newUsers $ NE.map cs (NE.fromList mails)) :: CmdRandom DevEnv BackendInternalError (NonEmpty UserId))
     putStrLn (show x :: Text)
 
 adminCmd :: HasCallStack => Mod CommandFields CLI

bin/gargantext-cli/CLI/Init.hs

@@ -29,8 +29,7 @@ import Gargantext.Database.Action.Flow (getOrMkRoot, getOrMkRootWithCorpus)
 import Gargantext.Database.Admin.Trigger.Init (initFirstTriggers, initLastTriggers)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (DBCmd')
-import Gargantext.Database.Prelude (DBCmd)
+import Gargantext.Database.Prelude (DBCmd, DBCmdWithEnv)
 import Gargantext.Database.Query.Table.Node (getOrMkList)
 import Gargantext.Database.Query.Table.User (insertNewUsers, )
 import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserMaster))
@@ -49,18 +48,18 @@ initCLI (InitArgs settingsPath) = do
   cfg       <- readConfig         settingsPath
   let secret = _s_secret_key $ _gc_secrets cfg
 
-  let createUsers :: forall env. DBCmd' env BackendInternalError Int64
+  let createUsers :: forall env. DBCmdWithEnv env BackendInternalError Int64
       createUsers = insertNewUsers (NewUser "gargantua" (cs email) (GargPassword $ cs password)
                                    NE.:| arbitraryNewUsers
                                    )
 
   let
-    mkRoots :: forall env. DBCmd' env BackendInternalError [(UserId, RootId)]
+    mkRoots :: forall env. DBCmdWithEnv env BackendInternalError [(UserId, RootId)]
     mkRoots = mapM getOrMkRoot $ map UserName ("gargantua" : arbitraryUsername)
     -- TODO create all users roots
 
   let
-    initMaster :: forall env. DBCmd' env BackendInternalError (UserId, RootId, CorpusId, ListId)
+    initMaster :: forall env. DBCmdWithEnv env BackendInternalError (UserId, RootId, CorpusId, ListId)
     initMaster = do
       (masterUserId, masterRootId, masterCorpusId)
                   <- getOrMkRootWithCorpus MkCorpusUserMaster

bin/gargantext-cli/CLI/Invitations.hs

@@ -16,16 +16,15 @@ module CLI.Invitations where
 
 import CLI.Parsers
 import CLI.Types
+import Control.Monad.Random (MonadRandom)
 import Gargantext.API.Dev (withDevEnv, runCmdDev)
 import Gargantext.API.Errors.Types
 import Gargantext.API.Node () -- instances only
 import Gargantext.API.Node.Share qualified as Share
 import Gargantext.API.Node.Share.Types qualified as Share
-import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
-import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Prelude (CmdRandom)
+import Gargantext.Database.Prelude (IsDBCmdExtra)
 import Gargantext.Prelude
 import Options.Applicative
 import Prelude (String)
@@ -34,9 +33,8 @@ invitationsCLI :: InvitationsArgs -> IO ()
 invitationsCLI (InvitationsArgs settingsPath user node_id email) = do
   -- _cfg       <- readConfig settingsPath
 
-  let invite :: ( CmdRandom env BackendInternalError m
-                , HasNLPServer env
-                , CET.HasCentralExchangeNotification env ) => m Int
+  let invite :: (IsDBCmdExtra env BackendInternalError m, MonadRandom m)
+             => m Int
       invite = Share.api (UserName $ cs user) node_id (Share.ShareTeamParams $ cs email)
 
   withDevEnv settingsPath $ \env -> do

bin/gargantext-cli/CLI/Upgrade.hs

@@ -52,47 +52,9 @@ upgradeCLI (UpgradeArgs settingsFile) = do
   let _secret = _s_secret_key $ _gc_secrets cfg
 
   withDevEnv settingsFile $ \_env -> do
-    -- _ <- runCmdDev env addIndex
-    -- _ <- runCmdDev env refreshIndex
-
-
-    ___
     putStrLn ("Uprade done with success !" :: Text)
-    ___
     pure ()
 
--- refreshIndex :: Cmd'' DevEnv IOException ()
--- refreshIndex = do
---   _ <- execPGSQuery [sql| REFRESH MATERIALIZED VIEW CONCURRENTLY context_node_ngrams_view; |] ()
---   pure ()
-
--- addIndex :: Cmd'' DevEnv IOException Int64
--- addIndex = do
---   execPGSQuery query ()
---     where
---       query = [sql|
---         CREATE MATERIALIZED VIEW IF NOT EXISTS context_node_ngrams_view AS
---           SELECT DISTINCT context_node_ngrams.context_id, ngrams_id, nodes_contexts.node_id
---           FROM nodes_contexts
---           JOIN context_node_ngrams
---           ON context_node_ngrams.context_id = nodes_contexts.context_id;
-
---         CREATE INDEX IF NOT EXISTS context_node_ngrams_context_id_ngrams_id_idx
---           ON context_node_ngrams(context_id, ngrams_id);
-
---         CREATE INDEX IF NOT EXISTS context_node_ngrams_view_context_id_idx
---           ON context_node_ngrams_view(context_id);
---         CREATE INDEX IF NOT EXISTS context_node_ngrams_view_ngrams_id_idx
---           ON context_node_ngrams_view(ngrams_id);
---         CREATE INDEX IF NOT EXISTS context_node_ngrams_view_node_id_idx
---           ON context_node_ngrams_view(node_id);
---         CREATE UNIQUE INDEX IF NOT EXISTS context_node_ngrams_view_context_ngrams_node_uniq_idx
---           ON context_node_ngrams_view (context_id, ngrams_id, node_id);
-
---         CREATE INDEX IF NOT EXISTS node_stories_ngrams_id_idx
---           ON node_stories(ngrams_id);
---   |]
-
 upgradeCmd :: HasCallStack => Mod CommandFields CLI
 upgradeCmd = command "upgrade" (info (helper <*> fmap CLISub upgrade_p) (progDesc "Upgrade a Gargantext node."))
 

gargantext.cabal

@@ -675,6 +675,7 @@ executable gargantext
     , haskell-bee
     , ini ^>= 0.4.1
     , lens >= 5.2.2 && < 5.3
+    , MonadRandom ^>= 0.6
     , monad-logger ^>= 0.3.36
     , optparse-applicative
     , optparse-generic ^>= 1.4.7

src/Gargantext/API/Admin/Auth.hs

@@ -62,7 +62,7 @@ import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
 import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
 import Gargantext.Database.Action.User.New (guessUserName)
 import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId)
-import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
+import Gargantext.Database.Prelude (Cmd, IsDBEnvExtra, IsDBCmd)
 import Gargantext.Database.Query.Table.User
 import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
 import Gargantext.Database.Query.Tree.Root (getRoot)
@@ -81,7 +81,7 @@ import Servant.Server.Generic (AsServerT)
 makeTokenForUser :: (HasJWTSettings env, HasAuthenticationError err)
                  => NodeId
                  -> UserId
-                 -> Cmd' env err Token
+                 -> Cmd env err Token
 makeTokenForUser nodeId userId = do
   jwtS <- view jwtSettings
   e <- liftBase $ makeJWT (AuthenticatedUser nodeId userId) jwtS Nothing
@@ -89,7 +89,7 @@ makeTokenForUser nodeId userId = do
   either (authenticationError . LoginFailed nodeId userId) (pure . toStrict . LE.decodeUtf8) e
   -- TODO not sure about the encoding...
 
-checkAuthRequest :: ( HasJWTSettings env, HasAuthenticationError err, DbCmd' env err m )
+checkAuthRequest :: ( HasJWTSettings env, HasAuthenticationError err, IsDBCmd env err m )
                  => Username
                  -> GargPassword
                  -> m CheckAuth
@@ -114,7 +114,7 @@ checkAuthRequest couldBeEmail (GargPassword p) = do
               token <- makeTokenForUser nodeId userLight_id
               pure $ Valid token nodeId userLight_id
 
-auth :: (HasJWTSettings env, HasAuthenticationError err, DbCmd' env err m)
+auth :: (HasJWTSettings env, HasAuthenticationError err, IsDBCmd env err m)
      => AuthRequest -> m AuthResponse
 auth (AuthRequest u p) = do
   checkAuthRequest' <- checkAuthRequest u p
@@ -138,7 +138,7 @@ authCheck _env (BasicAuthData login password) = pure $
   maybe Indefinite Authenticated $ TODO
 -}
 
-withAccessM :: ( DbCmd' env err m )
+withAccessM :: ( IsDBCmd env err m )
             => AuthenticatedUser
             -> PathId
             -> m a
@@ -229,19 +229,18 @@ All users can access to the Team folder as if they were owner.
 -}
 
 forgotPassword :: IsGargServer env err m => Named.ForgotPasswordAPI (AsServerT m)
-     -- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
 forgotPassword = Named.ForgotPasswordAPI
   { forgotPasswordPostEp = forgotPasswordPost
   , forgotPasswordGetEp  = forgotPasswordGet
   }
 
-forgotPasswordPost :: (CmdCommon env)
-     => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
+forgotPasswordPost :: (IsDBEnvExtra env)
+     => ForgotPasswordRequest -> Cmd env err ForgotPasswordResponse
 forgotPasswordPost (ForgotPasswordRequest _email) = do
   pure $ ForgotPasswordResponse "ok"
 
-forgotPasswordGet :: (CmdCommon env, HasServerError err)
-     => Maybe Text -> Cmd' env err ForgotPasswordGet
+forgotPasswordGet :: (IsDBEnvExtra env, HasServerError err)
+     => Maybe Text -> Cmd env err ForgotPasswordGet
 forgotPasswordGet Nothing = pure $ ForgotPasswordGet ""
 forgotPasswordGet (Just uuid) = do
   let mUuid = fromText uuid
@@ -257,8 +256,8 @@ forgotPasswordGet (Just uuid) = do
 
 ---------------------
 
-forgotPasswordGetUser :: ( CmdCommon env)
-     => UserLight -> Cmd' env err ForgotPasswordGet
+forgotPasswordGetUser :: ( IsDBEnvExtra env)
+     => UserLight -> Cmd env err ForgotPasswordGet
 forgotPasswordGetUser (UserLight { .. }) = do
   -- pick some random password
   password <- liftBase gargPass
@@ -276,8 +275,8 @@ forgotPasswordGetUser (UserLight { .. }) = do
 
   pure $ ForgotPasswordGet password
 
-forgotUserPassword :: (CmdCommon env)
-     => UserLight -> Cmd' env err ()
+forgotUserPassword :: (IsDBEnvExtra env)
+     => UserLight -> Cmd env err ()
 forgotUserPassword (UserLight { .. }) = do
   --printDebug "[forgotUserPassword] userLight_id" userLight_id
   --logDebug $ "[forgotUserPassword]" :# ["userLight_id" .= userLight_id]
@@ -301,8 +300,8 @@ forgotUserPassword (UserLight { .. }) = do
 --------------------------
 
 -- Generate a unique (in whole DB) UUID for passwords.
-generateForgotPasswordUUID :: (CmdCommon env)
-  => Cmd' env err UUID
+generateForgotPasswordUUID :: (IsDBEnvExtra env)
+  => Cmd env err UUID
 generateForgotPasswordUUID = do
   uuid <- liftBase $ nextRandom
   us <- getUsersWithForgotPasswordUUID uuid

src/Gargantext/API/Dev.hs

@@ -23,7 +23,7 @@ import Gargantext.API.Prelude ( GargM )
 import Gargantext.Core.Config (_gc_database_config)
 import Gargantext.Core.Config.Types (SettingsFile(..))
 import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
-import Gargantext.Database.Prelude (Cmd', Cmd'', connPool, runCmd)
+import Gargantext.Database.Prelude (Cmd, CmdRandom, connPool, runCmd)
 import Gargantext.Prelude
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.System.Logging ( withLoggerHoisted )
@@ -52,17 +52,17 @@ defaultSettingsFile :: SettingsFile
 defaultSettingsFile = SettingsFile "gargantext-settings.toml"
 
 -- | Run Cmd Sugar for the Repl (GHCI)
-runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
+runCmdRepl :: Show err => CmdRandom DevEnv err a -> IO a
 runCmdRepl f = withDevEnv defaultSettingsFile $ \env -> runCmdDev env f
 
-runCmdReplServantErr :: Cmd'' DevEnv ServerError a -> IO a
+runCmdReplServantErr :: CmdRandom DevEnv ServerError a -> IO a
 runCmdReplServantErr = runCmdRepl
 
 -- In particular this writes the repo file after running
 -- the command.
 -- This function is constrained to the DevEnv rather than
 -- using HasConnectionPool and HasRepoVar.
-runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
+runCmdDev :: Show err => DevEnv -> CmdRandom DevEnv err a -> IO a
 runCmdDev env f =
   either (fail . show) pure =<< runCmd env f
 
@@ -70,13 +70,13 @@ runCmdGargDev :: DevEnv -> GargM DevEnv BackendInternalError a -> IO a
 runCmdGargDev env cmd =
   either (fail . show) pure =<< runExceptT (runReaderT cmd env)
 
-runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
+runCmdDevNoErr :: DevEnv -> Cmd DevEnv () a -> IO a
 runCmdDevNoErr = runCmdDev
 
-runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
+runCmdDevServantErr :: DevEnv -> Cmd DevEnv ServerError a -> IO a
 runCmdDevServantErr = runCmdDev
 
-runCmdReplEasy :: Cmd'' DevEnv BackendInternalError a -> IO a
+runCmdReplEasy :: CmdRandom DevEnv BackendInternalError a -> IO a
 runCmdReplEasy f = withDevEnv defaultSettingsFile $ \env -> runCmdDev env f
 
 -- | Execute a function that takes PSQL.Connection from the DB pool as

src/Gargantext/API/GraphQL.hs

@@ -42,7 +42,7 @@ import Gargantext.API.Prelude (GargM)
 import Gargantext.API.Types (HTML)
 import Gargantext.Core.Config (HasJWTSettings)
 import Gargantext.Core.NLP (HasNLPServer)
-import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Prelude (IsDBEnvExtra)
 import Gargantext.Prelude hiding (ByteString)
 import Servant
 import Servant.Auth qualified as SA
@@ -98,7 +98,7 @@ data Contet m
 -- | The main GraphQL resolver: how queries, mutations and
 -- subscriptions are handled.
 rootResolver
-  :: (CmdCommon env, HasNLPServer env, HasJWTSettings env)
+  :: (IsDBEnvExtra env, HasNLPServer env, HasJWTSettings env)
   => AuthenticatedUser
   -> AccessPolicyManager
   -> RootResolver (GargM env BackendInternalError) e Query Mutation Undefined
@@ -129,7 +129,7 @@ rootResolver authenticatedUser policyManager =
 
 -- | Main GraphQL "app".
 app
-  :: (Typeable env, CmdCommon env, HasNLPServer env, HasJWTSettings env)
+  :: (Typeable env, IsDBEnvExtra env, HasNLPServer env, HasJWTSettings env)
   => AuthenticatedUser
   -> AccessPolicyManager
   -> App (EVENT (GargM env BackendInternalError)) (GargM env BackendInternalError)
@@ -167,7 +167,7 @@ data GraphQLAPIEndpoints mode = GraphQLAPIEndpoints
 
 -- | Implementation of our API.
 api
-  :: (Typeable env, CmdCommon env, HasJWTSettings env)
+  :: (Typeable env, IsDBEnvExtra env, HasJWTSettings env)
   => GraphQLAPI (AsServerT (GargM env BackendInternalError))
 api = GraphQLAPI $ \case
   (SAS.Authenticated auser)

src/Gargantext/API/GraphQL/Annuaire.hs

@@ -23,7 +23,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact
   , cw_lastName
   , hc_who, ContactWhere, hc_where, cw_organization, cw_labTeamDepts, cw_role, cw_office, cw_country, cw_city, cw_touch, ct_mail, ct_phone, ct_url, hc_title, hc_source)
 import Gargantext.Database.Admin.Types.Node (ContextId (..))
-import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Prelude (IsDBEnvExtra)
 import Gargantext.Database.Query.Table.Context (getContextWith)
 import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
@@ -55,13 +55,13 @@ data AnnuaireContactArgs
 
 -- | Function to resolve user from a query.
 resolveAnnuaireContacts
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => AnnuaireContactArgs -> GqlM e env [AnnuaireContact]
 resolveAnnuaireContacts AnnuaireContactArgs { contact_id } = dbAnnuaireContacts contact_id
 
 -- | Inner function to fetch the user from DB.
 dbAnnuaireContacts
-  :: CmdCommon env
+  :: IsDBEnvExtra env
   => Int -> GqlM e env [AnnuaireContact]
 dbAnnuaireContacts contact_id = do
   -- lift $ printDebug "[dbUsers]" user_id

src/Gargantext/API/GraphQL/Context.hs

@@ -33,7 +33,7 @@ import Gargantext.API.Prelude (GargM)
 import Gargantext.Core.Types.Search (HyperdataRow(..), toHyperdataRow)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument )
 import Gargantext.Database.Admin.Types.Node (ContextTitle, NodeId(..), NodeTypeId, UserId, unNodeId, ContextId (..))
-import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Prelude (IsDBEnvExtra)
 import Gargantext.Database.Query.Table.NodeContext (getNodeContext, getContextsForNgramsTerms, ContextForNgramsTerms(..), {- getContextNgrams, -} getContextNgramsMatchingFTS)
 import Gargantext.Database.Query.Table.NodeContext qualified as DNC
 import Gargantext.Database.Schema.NodeContext (NodeContext, NodeContextPoly(..))
@@ -119,19 +119,19 @@ type GqlM' e env a = ResolverM e (GargM env BackendInternalError) a
 
 -- | Function to resolve context from a query.
 resolveNodeContext
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => NodeContextArgs -> GqlM e env [NodeContextGQL]
 resolveNodeContext NodeContextArgs { context_id, node_id } =
   dbNodeContext context_id node_id
 
 resolveContextsForNgrams
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => ContextsForNgramsArgs -> GqlM e env [ContextGQL]
 resolveContextsForNgrams ContextsForNgramsArgs { corpus_id, ngrams_terms, and_logic } =
   dbContextForNgrams corpus_id ngrams_terms and_logic
 
 resolveContextNgrams
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => ContextNgramsArgs -> GqlM e env [Text]
 resolveContextNgrams ContextNgramsArgs { context_id, list_id } =
   dbContextNgrams context_id list_id
@@ -140,7 +140,7 @@ resolveContextNgrams ContextNgramsArgs { context_id, list_id } =
 
 -- | Inner function to fetch the node context DB.
 dbNodeContext
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => Int -> Int -> GqlM e env [NodeContextGQL]
 dbNodeContext context_id node_id = do
   -- lift $ printDebug "[dbUsers]" user_id
@@ -152,7 +152,7 @@ dbNodeContext context_id node_id = do
 
 -- | Returns list of `ContextGQL` for given ngrams in given corpus id.
 dbContextForNgrams
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => Int -> [Text] -> Text -> GqlM e env [ContextGQL]
 dbContextForNgrams node_id ngrams_terms and_logic = do
   contextsForNgramsTerms <- lift $ getContextsForNgramsTerms (UnsafeMkNodeId node_id) ngrams_terms ( readMaybe $ unpack $ Text.toTitle and_logic )
@@ -161,7 +161,7 @@ dbContextForNgrams node_id ngrams_terms and_logic = do
 
 -- | Fetch ngrams matching given context in a given list id.
 dbContextNgrams
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => Int -> Int -> GqlM e env [Text]
 dbContextNgrams context_id list_id = do
   lift $ getContextNgramsMatchingFTS (UnsafeMkContextId context_id) (UnsafeMkNodeId list_id)
@@ -221,7 +221,7 @@ toHyperdataRowDocumentGQL hyperdata =
                                      }
     HyperdataRowContact { } -> Nothing
 
-updateNodeContextCategory :: (CmdCommon env)
+updateNodeContextCategory :: (IsDBEnvExtra env)
                           => AuthenticatedUser
                           -> AccessPolicyManager
                           -> NodeContextCategoryMArgs

src/Gargantext/API/GraphQL/Node.hs

@@ -24,7 +24,7 @@ import Gargantext.API.GraphQL.Types ( GqlM )
 import Gargantext.Core ( HasDBid(lookupDBid) )
 import Gargantext.Database.Admin.Types.Node (NodeType)
 import Gargantext.Database.Admin.Types.Node qualified as NN
-import Gargantext.Database.Prelude (CmdCommon)  -- , JSONB)
+import Gargantext.Database.Prelude (IsDBEnvExtra)  -- , JSONB)
 import Gargantext.Database.Query.Table.Node (getClosestChildrenByType, getClosestParentIdByType, getNode)
 import Gargantext.Database.Schema.Node qualified as N
 import Gargantext.Prelude
@@ -57,7 +57,7 @@ data NodeArgs
 
 -- | Function to resolve user from a query.
 resolveNodes
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => AuthenticatedUser
   -> AccessPolicyManager
   -> NodeArgs
@@ -66,19 +66,19 @@ resolveNodes autUser mgr NodeArgs { node_id } =
   withPolicy autUser mgr (nodeReadChecks $ NN.UnsafeMkNodeId node_id) $ dbNodes node_id
 
 resolveNodesCorpus
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => CorpusArgs -> GqlM e env [Corpus]
 resolveNodesCorpus CorpusArgs { corpus_id } = dbNodesCorpus corpus_id
 
 dbNodes
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => Int -> GqlM e env [Node]
 dbNodes node_id = do
   node <- lift $ getNode $ NN.UnsafeMkNodeId node_id
   pure [toNode node]
 
 dbNodesCorpus
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => Int -> GqlM e env [Corpus]
 dbNodesCorpus corpus_id = do
   corpus <- lift $ getNode $ NN.UnsafeMkNodeId corpus_id
@@ -97,17 +97,17 @@ data NodeChildrenArgs
     } deriving (Generic, GQLType)
 
 resolveNodeParent
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => NodeParentArgs -> GqlM e env [Node]
 resolveNodeParent NodeParentArgs { node_id, parent_type } = dbParentNodes node_id parent_type
 
 resolveNodeChildren
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => NodeChildrenArgs -> GqlM e env [Node]
 resolveNodeChildren NodeChildrenArgs { node_id, child_type } = dbChildNodes node_id child_type
 
 dbParentNodes
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => Int -> NodeType -> GqlM e env [Node]
 dbParentNodes node_id parentType = do
   -- let mParentType = readEither (T.unpack parent_type) :: Either Prelude.String NodeType
@@ -123,7 +123,7 @@ dbParentNodes node_id parentType = do
           node <- lift $ getNode id
           pure [toNode node]
 
-dbChildNodes :: (CmdCommon env)
+dbChildNodes :: (IsDBEnvExtra env)
              => Int -> NodeType -> GqlM e env [Node]
 dbChildNodes node_id childType = do
   childIds <- lift $ getClosestChildrenByType (NN.UnsafeMkNodeId node_id) childType -- (fromNodeTypeId parent_type_id)

src/Gargantext/API/GraphQL/Team.hs

@@ -25,7 +25,7 @@ import Gargantext.Core.Config (HasJWTSettings)
 import Gargantext.Core.Types (NodeId(..), unNodeId)
 import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Database.Action.Share (membersOf, deleteMemberShip)
-import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Prelude (IsDBEnvExtra)
 import Gargantext.Database.Query.Table.Node (getNode)
 import Gargantext.Database.Query.Table.User (getUsersWithNodeHyperdata)
 import Gargantext.Database.Schema.Node (NodePoly(Node, _node_id), _node_user_id)
@@ -53,10 +53,10 @@ data TeamDeleteMArgs = TeamDeleteMArgs
 
 type GqlM' e env a = ResolverM e (GargM env BackendInternalError) a
 
-resolveTeam :: (CmdCommon env) => TeamArgs -> GqlM e env Team
+resolveTeam :: (IsDBEnvExtra env) => TeamArgs -> GqlM e env Team
 resolveTeam TeamArgs { team_node_id } = dbTeam team_node_id
 
-dbTeam :: (CmdCommon env) =>
+dbTeam :: (IsDBEnvExtra env) =>
           Int -> GqlM e env Team
 dbTeam nodeId = do
   let nId = UnsafeMkNodeId nodeId
@@ -78,7 +78,7 @@ dbTeam nodeId = do
     getUsername ((UserLight {userLight_username}, _):_) = userLight_username
 
 -- TODO: list as argument
-deleteTeamMembership :: (CmdCommon env, HasJWTSettings env) =>
+deleteTeamMembership :: (IsDBEnvExtra env, HasJWTSettings env) =>
                         TeamDeleteMArgs -> GqlM' e env [Int]
 deleteTeamMembership TeamDeleteMArgs { token, shared_folder_id, team_node_id } = do
   teamNode <- lift $ getNode $ UnsafeMkNodeId team_node_id

src/Gargantext/API/GraphQL/TreeFirstLevel.hs

@@ -25,7 +25,7 @@ import Gargantext.Core.Types.Main ( Tree(..), _tn_node, _tn_children, NodeTree(.
 import Gargantext.Database.Admin.Config ()
 import Gargantext.Database.Admin.Types.Node (allNodeTypes, NodeId(..), NodeType)
 import Gargantext.Database.Admin.Types.Node qualified as NN
-import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Prelude (IsDBEnvExtra)
 import Gargantext.Database.Query.Table.Node (getNode)
 import Gargantext.Database.Query.Tree qualified as T
 import Gargantext.Database.Schema.Node (NodePoly(_node_parent_id))
@@ -65,7 +65,7 @@ data BreadcrumbInfo = BreadcrumbInfo
 
 type ParentId = Maybe NodeId
 
-resolveTree :: (CmdCommon env)
+resolveTree :: (IsDBEnvExtra env)
             => AuthenticatedUser
             -> AccessPolicyManager
             -> TreeArgs
@@ -73,7 +73,7 @@ resolveTree :: (CmdCommon env)
 resolveTree autUser mgr TreeArgs { root_id } =
   withPolicy autUser mgr (nodeReadChecks $ UnsafeMkNodeId root_id) $ dbTree (_auth_user_id autUser) root_id
 
-dbTree :: (CmdCommon env) =>
+dbTree :: (IsDBEnvExtra env) =>
           NN.UserId -> Int -> GqlM e env (TreeFirstLevel (GqlM e env))
 dbTree loggedInUserId root_id = do
   let rId = UnsafeMkNodeId root_id
@@ -85,7 +85,7 @@ dbTree loggedInUserId root_id = do
     toParentId N.Node { _node_parent_id } = _node_parent_id
 
 
-toTree :: (CmdCommon env) => NodeId -> ParentId -> Tree NodeTree -> TreeFirstLevel (GqlM e env)
+toTree :: (IsDBEnvExtra env) => NodeId -> ParentId -> Tree NodeTree -> TreeFirstLevel (GqlM e env)
 toTree rId pId TreeN { _tn_node, _tn_children } = TreeFirstLevel
   { parent   = resolveParent pId
   , root     = toTreeNode pId _tn_node
@@ -98,7 +98,7 @@ toTreeNode pId NodeTree { _nt_name, _nt_id, _nt_type } = TreeNode { name = _nt_n
 childrenToTreeNodes :: (Tree NodeTree, NodeId) -> TreeNode
 childrenToTreeNodes (TreeN {_tn_node}, rId) = toTreeNode (Just rId) _tn_node
 
-resolveParent :: (CmdCommon env) => Maybe NodeId -> GqlM e env (Maybe TreeNode)
+resolveParent :: (IsDBEnvExtra env) => Maybe NodeId -> GqlM e env (Maybe TreeNode)
 resolveParent (Just pId) = do
   node <- lift $ getNode pId
   pure $ nodeToTreeNode node
@@ -117,7 +117,7 @@ nodeToTreeNode N.Node {..} =
    else
      Nothing
 
-resolveBreadcrumb :: (CmdCommon env) => BreadcrumbArgs -> GqlM e env BreadcrumbInfo
+resolveBreadcrumb :: (IsDBEnvExtra env) => BreadcrumbArgs -> GqlM e env BreadcrumbInfo
 resolveBreadcrumb BreadcrumbArgs { node_id } = dbRecursiveParents node_id
 
 convertDbTreeToTreeNode :: HasCallStack => T.DbTreeNode -> TreeNode
@@ -130,7 +130,7 @@ convertDbTreeToTreeNode T.DbTreeNode { _dt_name, _dt_nodeId, _dt_typeId, _dt_par
     }
 
 
-dbRecursiveParents :: (CmdCommon env) => Int -> GqlM e env BreadcrumbInfo
+dbRecursiveParents :: (IsDBEnvExtra env) => Int -> GqlM e env BreadcrumbInfo
 dbRecursiveParents nodeId = do
   let nId = UnsafeMkNodeId nodeId
   dbParents <- lift $ T.recursiveParents nId allNodeTypes

src/Gargantext/API/GraphQL/User.hs

@@ -22,7 +22,7 @@ import Gargantext.API.GraphQL.Types (GqlM, GqlM')
 import Gargantext.Core.Types (NodeId(..), UserId)
 import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
-import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Prelude (IsDBEnvExtra)
 import Gargantext.Database.Query.Table.User qualified as DBUser
 import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
@@ -60,7 +60,7 @@ data UserEPOAPITokenMArgs
 
 -- | Function to resolve user from a query.
 resolveUsers
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => AuthenticatedUser
   -> AccessPolicyManager
   -> UserArgs
@@ -70,12 +70,12 @@ resolveUsers autUser mgr UserArgs { user_id } = do
   withPolicy autUser mgr (nodeReadChecks $ UnsafeMkNodeId user_id) $ dbUsers user_id
 
 -- | Inner function to fetch the user from DB.
-dbUsers :: (CmdCommon env)
+dbUsers :: (IsDBEnvExtra env)
         => Int -> GqlM e env [User (GqlM e env)]
 dbUsers user_id = lift (map toUser <$> DBUser.getUsersWithId (Individu.RootId $ UnsafeMkNodeId user_id))
 
 toUser
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => UserLight -> User (GqlM e env)
 toUser (UserLight { .. }) = User { u_email = userLight_email
                                  , u_hyperdata = resolveHyperdata userLight_id
@@ -83,25 +83,25 @@ toUser (UserLight { .. }) = User { u_email = userLight_email
                                  , u_username = userLight_username }
 
 resolveHyperdata
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => UserId -> GqlM e env (Maybe HyperdataUser)
 resolveHyperdata userid = lift (listToMaybe <$> DBUser.getUserHyperdata (Individu.UserDBId userid))
 
-updateUserPubmedAPIKey :: ( CmdCommon env ) =>
+updateUserPubmedAPIKey :: ( IsDBEnvExtra env ) =>
                           UserPubmedAPIKeyMArgs -> GqlM' e env Int
 updateUserPubmedAPIKey UserPubmedAPIKeyMArgs { user_id, api_key } = do
   _ <- lift $ DBUser.updateUserPubmedAPIKey (Individu.RootId $ UnsafeMkNodeId user_id) api_key
 
   pure 1
 
-updateUserEPOAPIUser :: ( CmdCommon env ) =>
+updateUserEPOAPIUser :: ( IsDBEnvExtra env ) =>
                         UserEPOAPIUserMArgs -> GqlM' e env Int
 updateUserEPOAPIUser UserEPOAPIUserMArgs { user_id, api_user } = do
   _ <- lift $ DBUser.updateUserEPOAPIUser (Individu.RootId $ UnsafeMkNodeId user_id) api_user
 
   pure 1
 
-updateUserEPOAPIToken :: ( CmdCommon env ) =>
+updateUserEPOAPIToken :: ( IsDBEnvExtra env ) =>
                          UserEPOAPITokenMArgs -> GqlM' e env Int
 updateUserEPOAPIToken UserEPOAPITokenMArgs { user_id, api_token } = do
   _ <- lift $ DBUser.updateUserEPOAPIToken (Individu.RootId $ UnsafeMkNodeId user_id) api_token

src/Gargantext/API/GraphQL/UserInfo.hs

@@ -49,7 +49,7 @@ import Gargantext.API.GraphQL.Utils (AuthStatus(Invalid, Valid), authUser)
 import Gargantext.Core.Config (HasJWTSettings)
 import Gargantext.Core.Types (UserId(..))
 import Gargantext.Core.Types.Individu qualified as Individu
-import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Prelude (IsDBEnvExtra)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Query.Table.User (getUsersWithHyperdata, getUsersWithNodeHyperdata, updateUserEmail)
 import Gargantext.Database.Schema.Node (node_id, node_hyperdata, NodePoly (Node, _node_id))
@@ -108,7 +108,7 @@ data UserInfoMArgs
 
 -- | Function to resolve user from a query.
 resolveUserInfos
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => AuthenticatedUser
   -> AccessPolicyManager
   -> UserInfoArgs -> GqlM e env [UserInfo]
@@ -118,7 +118,7 @@ resolveUserInfos autUser mgr UserInfoArgs { user_id } =
 
 -- | Mutation for user info
 updateUserInfo
-  :: (CmdCommon env, HasJWTSettings env)
+  :: (IsDBEnvExtra env, HasJWTSettings env)
   -- => UserInfoMArgs -> ResolverM e (GargM env err) Int
   => UserInfoMArgs -> GqlM' e env Int
 updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
@@ -167,7 +167,7 @@ updateUserInfo (UserInfoMArgs { ui_id, .. }) = do
 
 -- | Inner function to fetch the user from DB.
 dbUsers
-  :: (CmdCommon env)
+  :: (IsDBEnvExtra env)
   => UserId -> GqlM e env [UserInfo]
 dbUsers user_id = do
   -- lift $ printDebug "[dbUsers]" user_id

src/Gargantext/API/GraphQL/Utils.hs

@@ -16,13 +16,13 @@ import Control.Lens (view)
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (..), auth_node_id)
 import Gargantext.Core.Config (HasJWTSettings(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
-import Gargantext.Database.Prelude (Cmd')
+import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Prelude
 import Servant.Auth.Server (verifyJWT, JWTSettings)
 
 data AuthStatus = Valid | Invalid
 
-authUser :: (HasJWTSettings env) => NodeId -> Text -> Cmd' env err AuthStatus
+authUser :: (HasJWTSettings env) => NodeId -> Text -> Cmd env err AuthStatus
 authUser ui_id token = do
   let token' = encodeUtf8 token
   jwtS <- view jwtSettings

src/Gargantext/API/Ngrams/Types.hs

@@ -47,7 +47,7 @@ import Gargantext.Core.Utils.Aeson (jsonOptions)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger)
 import Gargantext.Core.Utils.Swagger (wellNamedSchema)
 import Gargantext.Database.Admin.Types.Node (ContextId)
-import Gargantext.Database.Prelude (fromField', HasConnectionPool, CmdM')
+import Gargantext.Database.Prelude (fromField', HasConnectionPool, IsCmd)
 import Gargantext.Prelude hiding (IsString, hash, from, replace, to)
 import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
 import Gargantext.Utils.Servant (TSV, ZIP)
@@ -730,7 +730,7 @@ initRepo = Repo 1 mempty []
 --------------------
 
 type RepoCmdM   env err m =
-  ( CmdM'             env err m
+  ( IsCmd             env err m
   , HasConnectionPool env
   , HasConfig         env
   )

src/Gargantext/API/Node.hs

@@ -59,7 +59,7 @@ import Gargantext.Database.Action.Flow.Pairing (pairing)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny, HyperdataCorpus, HyperdataAnnuaire)
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( HyperdataC )
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, JSONB)
+import Gargantext.Database.Prelude (DBCmdExtra, JSONB)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Children (getChildren)
 import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
@@ -143,7 +143,7 @@ type ScoreApi =  Summary " To Score NodeNodes"
 scoreApi :: CorpusId -> GargServer ScoreApi
 scoreApi = putScore
   where
-    putScore :: CorpusId -> NodesToScore -> Cmd err [Int]
+    putScore :: CorpusId -> NodesToScore -> DBCmdExtra err [Int]
     putScore cId cs' = nodeContextsScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs')
 
 ------------------------------------------------------------------------
@@ -182,20 +182,20 @@ treeFlatAPI authenticatedUser rootId =
 
 ------------------------------------------------------------------------
 -- | TODO Check if the name is less than 255 char
-rename :: HasNodeError err => UserId -> NodeId -> RenameNode -> Cmd err [Int]
+rename :: HasNodeError err => UserId -> NodeId -> RenameNode -> DBCmdExtra err [Int]
 rename loggedInUserId nId (RenameNode name') = U.update loggedInUserId (U.Rename nId name')
 
 putNode :: forall err a. (HyperdataC a)
         => NodeId
         -> a
-        -> Cmd err Int
+        -> DBCmdExtra err Int
 putNode n h = fromIntegral <$> updateHyperdata n h
 
 moveNode :: HasNodeError err
          => UserId
          -> NodeId
          -> ParentId
-         -> Cmd err [Int]
+         -> DBCmdExtra err [Int]
 moveNode loggedInUserId n p = update loggedInUserId (Move n p)
 -------------------------------------------------------------
 

src/Gargantext/API/Node/Corpus/Export.hs

@@ -34,7 +34,7 @@ import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Action.Metrics.NgramsByContext (getNgramsByContextOnlyUser)
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument(..) )
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (DBCmdExtra)
 import Gargantext.Database.Query.Table.Node ( defaultList )
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
@@ -95,7 +95,7 @@ getContextNgrams :: HasNodeError err
         -> ListType
         -> NgramsType
         -> NodeListStory
-        -> Cmd err (Map ContextId (Set NgramsTerm))
+        -> DBCmdExtra err (Map ContextId (Set NgramsTerm))
 getContextNgrams cId lId listType nt repo = do
 --  lId <- case lId' of
 --    Nothing -> defaultList cId

src/Gargantext/API/Node/Corpus/Subcorpus.hs

@@ -10,13 +10,13 @@ import Gargantext.Core.Text.Corpus (makeSubcorpusFromQuery)
 import Gargantext.Core.Text.Corpus.Query (RawQuery(..), parseQuery)
 import Gargantext.Core.Types (UserId)
 import Gargantext.Core.Types.Individu (User(..))
-import Gargantext.Database.Prelude (DbCmd')
+import Gargantext.Database.Prelude (IsDBCmd)
 import Servant.Server.Generic (AsServerT)
 
 
 makeSubcorpus :: ( HasNodeStoryEnv env
                  , HasNLPServer    env
-                 , DbCmd' env BackendInternalError m
+                 , IsDBCmd env BackendInternalError m
                  )
   => UserId
   -> MakeSubcorpusAPI (AsServerT m)

src/Gargantext/API/Node/Corpus/Update.hs

@@ -19,7 +19,7 @@ import Control.Lens (over)
 import Gargantext.Core (Lang)
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus, _hc_lang)
 import Gargantext.Database.Admin.Types.Node (CorpusId)
-import Gargantext.Database.Prelude (DbCmd')
+import Gargantext.Database.Prelude (IsDBCmd)
 import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
@@ -29,7 +29,7 @@ import Gargantext.Utils.Jobs.Monad (MonadJobStatus)
 
 
 -- | Updates the 'HyperdataCorpus' with the input 'Lang'.
-addLanguageToCorpus :: (HasNodeError err, DbCmd' env err m, MonadJobStatus m)
+addLanguageToCorpus :: (HasNodeError err, IsDBCmd env err m, MonadJobStatus m)
                     => CorpusId
                     -> Lang
                     -> m ()

src/Gargantext/API/Node/New.hs

@@ -31,7 +31,7 @@ import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (CmdM, DBCmd')
+import Gargantext.Database.Prelude (IsDBCmdExtra, DBCmdWithEnv)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Prelude
 import Servant.Server.Generic (AsServerT)
@@ -47,7 +47,7 @@ postNode :: ( HasMail env
          -> NodeId
          -> PostNode
          -- -> m [NodeId]
-         -> DBCmd' env err [NodeId]
+         -> DBCmdWithEnv env err [NodeId]
 postNode authenticatedUser nId pn = do
   postNode' authenticatedUser nId pn
 
@@ -73,7 +73,7 @@ postNodeAsyncAPI authenticatedUser nId =
 --           -> PostNode
 --           -> m [NodeId]
 -- postNode' authenticatedUser pId (PostNode nodeName nt) = do
-postNode' :: ( CmdM env err m
+postNode' :: ( IsDBCmdExtra env err m
              , HasNodeError err
              , HasMail env
              , CE.HasCentralExchangeNotification env)

src/Gargantext/API/Node/Share.hs

@@ -15,20 +15,19 @@ Portability : POSIX
 module Gargantext.API.Node.Share
       where
 
+import Control.Monad.Random (MonadRandom)
 import Data.List qualified as List
 import Data.Text qualified as Text
 import Gargantext.API.Node.Share.Types (ShareNodeParams(..))
 import Gargantext.API.Prelude (IsGargServer)
 import Gargantext.API.Routes.Named.Share qualified as Named
-import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification)
-import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
 import Gargantext.Database.Action.Share (ShareNodeWith(..))
 import Gargantext.Database.Action.Share as DB (shareNodeWith, unshare)
 import Gargantext.Database.Action.User (getUserId', getUsername)
 import Gargantext.Database.Action.User.New (guessUserName, newUser)
 import Gargantext.Database.Admin.Types.Node (NodeId, NodeType(..), UserId(..))
-import Gargantext.Database.Prelude (CmdRandom)
+import Gargantext.Database.Prelude (IsDBCmdExtra)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Tree (findNodesWithType)
 import Gargantext.Prelude
@@ -38,10 +37,10 @@ import Servant.Server.Generic (AsServerT)
 -- TODO permission
 -- TODO refactor userId which is used twice
 -- TODO change return type for better warning/info/success/error handling on the front
-api :: ( HasNodeError err
-       , HasNLPServer env
-       , CmdRandom env err m
-       , HasCentralExchangeNotification env )
+api :: ( HasNodeError     err
+       , IsDBCmdExtra env err m
+       , MonadRandom          m
+       )
     => User
     -> NodeId
     -> ShareNodeParams

src/Gargantext/API/Node/ShareURL.hs

@@ -12,7 +12,7 @@ import Gargantext.API.Routes.Named.Share qualified as Named
 import Gargantext.Core.Config (GargConfig, gc_frontend_config, HasConfig(hasConfig))
 import Gargantext.Core.Config.Types (fc_appPort, fc_url)
 import Gargantext.Core.Types (NodeType, NodeId, unNodeId, _ValidationError)
-import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Prelude (IsDBEnvExtra)
 import Gargantext.Prelude
 import Network.URI (parseURI)
 import Prelude (String)
@@ -21,7 +21,7 @@ import Servant.Server.Generic (AsServerT)
 shareURL :: IsGargServer env err m => Named.ShareURL (AsServerT m)
 shareURL = Named.ShareURL getUrl
 
-getUrl :: (IsGargServer env err m, CmdCommon env)
+getUrl :: (IsGargServer env err m, IsDBEnvExtra env)
        => Maybe NodeType
        -> Maybe NodeId
        -> m Named.ShareLink

src/Gargantext/API/Prelude.hs

@@ -18,6 +18,7 @@ module Gargantext.API.Prelude
   , serverError ) where
 
 import Control.Lens ((#))
+import Control.Monad.Random (MonadRandom)
 import Gargantext.API.Admin.Auth.Types (AuthenticationError)
 import Gargantext.API.Errors.Class (HasAuthenticationError, _AuthenticationError)
 import Gargantext.API.Errors.Types (HasServerError(..), serverError)
@@ -27,7 +28,7 @@ import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.NodeStory (HasNodeStory, HasNodeStoryEnv)
 import Gargantext.Core.Types (HasValidationError)
-import Gargantext.Database.Prelude (CmdM, CmdRandom, HasConnectionPool)
+import Gargantext.Database.Prelude (IsDBCmdExtra, HasConnectionPool)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Tree (HasTreeError)
 import Gargantext.Prelude
@@ -58,8 +59,9 @@ type ErrC err =
   )
 
 type GargServerC env err m =
-  ( CmdRandom    env err m
-  , HasNodeStory env err m
+  ( HasNodeStory env err m
+  , HasMail      env
+  , MonadRandom          m
   , EnvC         env
   , ErrC             err
   , ToJSON           err
@@ -84,9 +86,9 @@ type GargNoServer t =
   forall env err m. GargNoServer' env err m => m t
 
 type GargNoServer' env err m =
-  ( CmdM           env err m
-  , HasNodeStory   env err m
-  , HasNodeError       err
+  ( IsDBCmdExtra env err m
+  , HasNodeStory env err m
+  , HasNodeError     err
   )
 
 ------------------------------------------------------------------------

src/Gargantext/API/Server/Named/Public.hs

@@ -17,7 +17,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( hc_fields )
 import Gargantext.Database.Admin.Types.Hyperdata.CorpusField
 import Gargantext.Database.Admin.Types.Hyperdata.Folder ( HyperdataFolder )
 import Gargantext.Database.Admin.Types.Node ( NodeId(..), Node, unNodeId )
-import Gargantext.Database.Prelude (Cmd, DBCmd)
+import Gargantext.Database.Prelude (DBCmd, DBCmdExtra)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Query.Table.NodeNode (selectPublicNodes)
 import Gargantext.Database.Schema.Node ( NodePoly(..), node_date, node_hyperdata ) -- (NodePoly(..))
@@ -68,7 +68,7 @@ filterPublicDatas datas =
       & Map.elems
 
 publicNodes :: HasNodeError err
-            => Cmd err (Set NodeId)
+            => DBCmdExtra err (Set NodeId)
 publicNodes = do
   candidates <- filterPublicDatas <$> selectPublicNodes
   pure $ Set.fromList

src/Gargantext/API/Table.hs

@@ -41,7 +41,7 @@ import Gargantext.Core.Types.Query (Offset, Limit)
 import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.Action.Search (searchCountInCorpus, searchInCorpus)
 import Gargantext.Database.Admin.Types.Node (ContactId, CorpusId, NodeId)
-import Gargantext.Database.Prelude (CmdM, DbCmd', DBCmd)
+import Gargantext.Database.Prelude (IsDBCmdExtra, IsDBCmd, DBCmd)
 import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Prelude
@@ -56,7 +56,7 @@ tableApi id' = Named.TableAPI
   }
 
 
-getTableApi :: (CmdM env err m, HasNodeError err, MonadLogger m)
+getTableApi :: (IsDBCmdExtra env err m, HasNodeError err, MonadLogger m)
             => NodeId
             -> Maybe TabType
             -> Maybe Limit
@@ -84,7 +84,7 @@ getTableApi cId tabType mLimit mOffset mOrderBy mQuery mYear =
       t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
       pure $ constructHashedResponse t
 
-postTableApi :: (CmdM env err m, MonadLogger m, HasNodeError err)
+postTableApi :: (IsDBCmdExtra env err m, MonadLogger m, HasNodeError err)
              => NodeId
              -> TableQuery
              -> m FacetTableResult
@@ -99,7 +99,7 @@ postTableApi cId tq = case tq of
    Trash -> searchInCorpus' cId True  q (Just o) (Just l) (Just order)
    x     -> panicTrace $ "not implemented in tableApi " <> (show x)
 
-getTableHashApi :: (CmdM env err m, HasNodeError err, MonadLogger m)
+getTableHashApi :: (IsDBCmdExtra env err m, HasNodeError err, MonadLogger m)
                 => NodeId
                 -> Maybe TabType
                 -> m Text
@@ -107,7 +107,7 @@ getTableHashApi cId tabType = do
   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
   pure h
 
-searchInCorpus' :: (DbCmd' env err m, MonadLogger m)
+searchInCorpus' :: (IsDBCmd env err m, MonadLogger m)
                 => CorpusId
                 -> Bool
                 -> RawQuery

src/Gargantext/Core/NodeStory/Types.hs

@@ -58,7 +58,7 @@ import Gargantext.Database.Admin.Types.Node ( NodeId(..) )
 import Gargantext.Core.Text.Ngrams qualified as Ngrams
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Admin.Config ()
-import Gargantext.Database.Prelude (DbCmd')
+import Gargantext.Database.Prelude (IsDBCmd)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Prelude hiding (to)
 import Opaleye (DefaultFromField(..), SqlJsonb, fromPGSFromField)
@@ -197,7 +197,7 @@ data NodeStoryEnv = NodeStoryEnv
   }
   deriving (Generic)
 
-type HasNodeStory env err m = ( DbCmd' env err m
+type HasNodeStory env err m = ( IsDBCmd env err m
                               , MonadReader env m
                               , MonadError  err m
                               , HasNodeStoryEnv env

src/Gargantext/Core/Text/Corpus.hs

@@ -19,7 +19,7 @@ import Gargantext.Database.Action.Search (searchInCorpus)
 import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus, hc_lang)
 import Gargantext.Database.Admin.Types.Node (CorpusId, NodeId(UnsafeMkNodeId), NodeType(..), nodeId2ContextId)
-import Gargantext.Database.Prelude (DBCmd')
+import Gargantext.Database.Prelude (DBCmdWithEnv)
 import Gargantext.Database.Query.Facet.Types (facetDoc_id)
 import Gargantext.Database.Query.Table.Node (insertDefaultNode, copyNodeStories, defaultList, getNodeWithType)
 import Gargantext.Database.Query.Table.Node.Document.Add qualified as Document (add)
@@ -55,7 +55,7 @@ makeSubcorpusFromQuery :: ( HasNodeStoryEnv env
   -> CorpusId -- ^ ID of the parent corpus
   -> Q.Query  -- ^ The query to determine the subset of documents that will appear in the subcorpus
   -> Bool     -- ^ Whether to reuse parent term list (True) or compute a new one based only on the documents in the subcorpus (False)
-  -> DBCmd' env BackendInternalError CorpusId -- ^ The child corpus ID
+  -> DBCmdWithEnv env BackendInternalError CorpusId -- ^ The child corpus ID
 makeSubcorpusFromQuery user supercorpusId query reuseParentList = do
   userId <- getUserId user
   -- Insert the required nodes:

src/Gargantext/Core/Viz/Graph/API.hs

@@ -37,7 +37,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOn
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Config ( userMaster )
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (DBCmd, DBCmd')
+import Gargantext.Database.Prelude (DBCmd, DBCmdWithEnv)
 import Gargantext.Database.Query.Table.Node ( getOrMkList, getNodeWith, defaultList, getClosestParentIdByType )
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select ( selectNodesWithUsername )
@@ -281,7 +281,7 @@ graphClone :: (HasNodeError err)
            => UserId
            -> NodeId
            -> HyperdataGraphAPI
-           -> DBCmd' env err NodeId
+           -> DBCmdWithEnv env err NodeId
 graphClone userId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
                                          , _hyperdataAPICamera = camera }) = do
   let nodeType = NodeGraph

src/Gargantext/Core/Worker/Jobs.hs

@@ -20,14 +20,14 @@ import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..))
 import Gargantext.Core.Worker.Broker (initBrokerWithDBCreate)
 import Gargantext.Core.Worker.Jobs.Types (Job(..))
 import Gargantext.Core.Worker.PGMQTypes (HasWorkerBroker, MessageId, SendJob)
-import Gargantext.Database.Prelude (Cmd')
+import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Prelude
 import Gargantext.System.Logging (logMsg, withLogger, LogLevel(..))
 
 
 sendJob :: (HasWorkerBroker, HasConfig env)
         => Job
-        -> Cmd' env err MessageId
+        -> Cmd env err MessageId
 sendJob job = do
   gcConfig <- view $ hasConfig
   liftBase $ sendJobWithCfg gcConfig job

src/Gargantext/Database/Action/Delete.hs

@@ -27,7 +27,7 @@ import Gargantext.Database.Action.User (getUserId)
 import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) )
 import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(..) ) -- (NodeType(..))
 import Gargantext.Database.GargDB qualified as GargDB
-import Gargantext.Database.Prelude (Cmd', CmdCommon)
+import Gargantext.Database.Prelude (Cmd, IsDBEnvExtra)
 import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node qualified as N (getNode, deleteNode)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
@@ -38,10 +38,10 @@ import Gargantext.Prelude
 -- TODO
 -- Delete Corpus children accoring its types
 -- Delete NodeList (NodeStory + cbor file)
-deleteNode :: (CmdCommon env, HasNodeError err)
+deleteNode :: (IsDBEnvExtra env, HasNodeError err)
            => User
            -> NodeId
-           -> Cmd' env err Int
+           -> Cmd env err Int
 deleteNode u nodeId = do
   node' <- N.getNode nodeId
   num <- case (view node_typename node') of

src/Gargantext/Database/Action/Flow.hs

@@ -94,7 +94,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact )
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire, HyperdataCorpus(_hc_lang) )
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( ToHyperdataDocument(toHyperdataDocument) )
 import Gargantext.Database.Admin.Types.Node hiding (DEBUG) -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
-import Gargantext.Database.Prelude (DbCmd', DBCmd')
+import Gargantext.Database.Prelude (IsDBCmd, DBCmdWithEnv)
 import Gargantext.Database.Query.Table.ContextNodeNgrams2 ( ContextNodeNgrams2Poly(..), insertContextNodeNgrams2 )
 import Gargantext.Database.Query.Table.Node ( MkCorpus, insertDefaultNodeIfNotExists, getOrMkList, getNodeWith )
 import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
@@ -136,7 +136,7 @@ getDataText :: (HasNodeError err)
             -> Maybe PUBMED.APIKey
             -> Maybe EPO.AuthKey
             -> Maybe API.Limit
-            -> DBCmd' env err (Either API.GetCorpusError DataText)
+            -> DBCmdWithEnv env err (Either API.GetCorpusError DataText)
 getDataText (ExternalOrigin api) la q mPubmedAPIKey mAuthKey li = do
   cfg <- view hasConfig
   eRes <- liftBase $ API.get api (_tt_lang la) q mPubmedAPIKey mAuthKey (_ac_epo_api_url $ _gc_apis cfg) li
@@ -151,7 +151,7 @@ getDataText_Debug :: (HasNodeError err)
                   -> TermType Lang
                   -> API.RawQuery
                   -> Maybe API.Limit
-                  -> DBCmd' env err ()
+                  -> DBCmdWithEnv env err ()
 getDataText_Debug a l q li = do
   result <- getDataText a l q Nothing Nothing li
   case result of
@@ -161,7 +161,7 @@ getDataText_Debug a l q li = do
 
 -------------------------------------------------------------------------------
 flowDataText :: forall env err m.
-                ( DbCmd' env err m
+                ( IsDBCmd env err m
                 , HasNodeStory env err m
                 , MonadLogger m
                 , HasNLPServer env
@@ -191,7 +191,7 @@ flowDataText u (DataNew (mLen, txtC)) tt cid mfslw jobHandle = do
 
 ------------------------------------------------------------------------
 -- TODO use proxy
-flowAnnuaire :: ( DbCmd' env err m
+flowAnnuaire :: ( IsDBCmd env err m
                 , HasNodeStory env err m
                 , MonadLogger m
                 , HasNLPServer env
@@ -210,7 +210,7 @@ flowAnnuaire mkCorpusUser l filePath jobHandle = do
   flow (Nothing :: Maybe HyperdataAnnuaire) mkCorpusUser l Nothing (fromIntegral $ length docs, yieldMany docs) jobHandle
 
 ------------------------------------------------------------------------
-flowCorpusFile :: ( DbCmd' env err m
+flowCorpusFile :: ( IsDBCmd env err m
                   , HasNodeStory env err m
                   , MonadLogger m
                   , HasNLPServer env
@@ -239,7 +239,7 @@ flowCorpusFile mkCorpusUser _l la ft ff fp mfslw jobHandle = do
 ------------------------------------------------------------------------
 -- | TODO improve the needed type to create/update a corpus
 -- (For now, Either is enough)
-flowCorpus :: ( DbCmd' env err m
+flowCorpus :: ( IsDBCmd env err m
               , HasNodeStory env err m
               , MonadLogger m
               , HasNLPServer env
@@ -258,7 +258,7 @@ flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
 
 
 flow :: forall env err m a c.
-        ( DbCmd' env err m
+        ( IsDBCmd env err m
         , HasNodeStory env err m
         , MonadLogger m
         , HasNLPServer env
@@ -300,7 +300,7 @@ flow c mkCorpusUser la mfslw (count, docsC) jobHandle = do
 
 -- | Given a list of corpus documents and a 'NodeId' identifying the 'CorpusId', adds
 -- the given documents to the corpus. Returns the Ids of the inserted documents.
-addDocumentsToHyperCorpus :: ( DbCmd' env err m
+addDocumentsToHyperCorpus :: ( IsDBCmd env err m
                              , HasNodeError err
                              , FlowCorpus document
                              , MkCorpus corpus
@@ -317,7 +317,7 @@ addDocumentsToHyperCorpus ncs mb_hyper la corpusId docs = do
   pure ids
 
 ------------------------------------------------------------------------
-createNodes :: ( DbCmd' env err m, HasNodeError err
+createNodes :: ( IsDBCmd env err m, HasNodeError err
                , MkCorpus c
                , HasCentralExchangeNotification env
                )
@@ -410,7 +410,7 @@ buildSocialList l user userCorpusId listId ctype mfslw = do
   pure ()
 
 
-insertMasterDocs :: ( DbCmd' env err m
+insertMasterDocs :: ( IsDBCmd env err m
                     , HasNodeError err
                     , FlowCorpus a
                     , MkCorpus   c
@@ -443,7 +443,7 @@ insertMasterDocs ncs c lang hs  =  do
   -- _cooc <- insertDefaultNode NodeListCooc lId masterUserId
   pure $ map contextId2NodeId ids'
 
-saveDocNgramsWith :: (DbCmd' env err m)
+saveDocNgramsWith :: (IsDBCmd env err m)
                   => ListId
                   -> HashMap.HashMap ExtractedNgrams (Map NgramsType (Map NodeId (Int, TermsCount)))
                   -> m ()

src/Gargantext/Database/Action/Flow/Pairing.hs

@@ -36,7 +36,7 @@ import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOn
 import Gargantext.Database.Admin.Config ( userMaster )
 import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact, cw_firstName, cw_lastName, hc_who ) -- (HyperdataContact(..))
 import Gargantext.Database.Admin.Types.Node -- (AnnuaireId, CorpusId, ListId, DocId, ContactId, NodeId)
-import Gargantext.Database.Prelude (Cmd, DBCmd, runOpaQuery)
+import Gargantext.Database.Prelude (DBCmd, DBCmdExtra, runOpaQuery)
 import Gargantext.Database.Query.Prelude (returnA)
 import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.Node.Children (getAllContacts)
@@ -51,7 +51,7 @@ import Opaleye
 -- | isPairedWith
 -- All NodeAnnuaire paired with a Corpus of NodeId nId:
 -- isPairedWith NodeAnnuaire corpusId
-isPairedWith :: NodeId -> NodeType -> Cmd err [NodeId]
+isPairedWith :: NodeId -> NodeType -> DBCmdExtra err [NodeId]
 isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
   where
     selectQuery :: NodeType -> NodeId -> Select (Column SqlInt4)

src/Gargantext/Database/Action/Flow/Types.hs

@@ -30,7 +30,7 @@ import Gargantext.Core.Types (HasValidationError, TermsCount)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument )
 import Gargantext.Database.Admin.Types.Node (NodeId)
-import Gargantext.Database.Prelude (CmdM)
+import Gargantext.Database.Prelude (IsDBCmdExtra)
 import Gargantext.Database.Query.Table.Node.Document.Insert ( UniqParameters, InsertDb, ToNode, AddUniqId )
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Tree.Error (HasTreeError)
@@ -40,12 +40,12 @@ import Gargantext.System.Logging ( MonadLogger )
 
 
 type FlowCmdM env err m =
-  ( CmdM     env err m
-  , HasNodeStory env err m
-  , HasNodeError err
+  ( IsDBCmdExtra   env err m
+  , HasNodeStory   env err m
+  , HasNodeError       err
   , HasValidationError err
-  , HasTreeError err
-  , MonadLogger m
+  , HasTreeError       err
+  , MonadLogger            m
   )
 
 type FlowCorpus a = ( UniqParameters a

src/Gargantext/Database/Action/Flow/Utils.hs

@@ -33,7 +33,7 @@ import Gargantext.Data.HashMap.Strict.Utils qualified as HashMap
 import Gargantext.Database.Action.Flow.Types (DocumentIdWithNgrams(..), FlowInsertDB)
 import Gargantext.Database.Admin.Types.Hyperdata.Document ( HyperdataDocument, hd_abstract, hd_title )
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (DBCmd, DbCmd')
+import Gargantext.Database.Prelude (DBCmd, IsDBCmd)
 import Gargantext.Database.Query.Table.ContextNodeNgrams ( ContextNodeNgramsPoly(..), insertContextNodeNgrams )
 import Gargantext.Database.Query.Table.Node.Document.Add qualified as Doc (add)
 import Gargantext.Database.Query.Table.Node.Document.Insert (ReturnId, addUniqId, insertDb, reId, reInserted, reUniqId)
@@ -119,7 +119,7 @@ mapNodeIdNgrams = HashMap.unionsWith (DM.unionWith (DM.unionWith addTuples)) . f
 
         
 -- TODO Type NodeDocumentUnicised
-insertDocs :: ( DbCmd' env err m
+insertDocs :: ( IsDBCmd env err m
               -- , FlowCorpus a
               , FlowInsertDB a
               , HasNodeError err

src/Gargantext/Database/Action/Mail.hs

@@ -20,7 +20,7 @@ import Gargantext.Core.Mail (mail, MailModel(..))
 import Gargantext.Core.Mail.Types (mailSettings)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.User
-import Gargantext.Database.Prelude (CmdM)
+import Gargantext.Database.Prelude (IsDBCmdExtra)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
 import Gargantext.Database.Schema.User
 import Gargantext.Prelude
@@ -28,7 +28,8 @@ import Gargantext.System.Logging (MonadLogger, LogLevel(..), logLocM)
 
 ------------------------------------------------------------------------
 
-sendMail :: (HasNodeError err, CmdM env err m, MonadLogger m) => User -> m ()
+sendMail :: (HasNodeError err, IsDBCmdExtra env err m, MonadLogger m)
+         => User -> m ()
 sendMail u = do
   cfg       <- view $ mailSettings
   userLight <- getUserLightDB u

src/Gargantext/Database/Action/Node.hs

@@ -26,7 +26,7 @@ import Gargantext.Core.Types (Name)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Hyperdata.Default
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (DBCmd')
+import Gargantext.Database.Prelude (DBCmdWithEnv)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
@@ -41,7 +41,7 @@ mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
                  -> Maybe ParentId
                  -> UserId
                  -> Name
-                 -> DBCmd' env err [NodeId]
+                 -> DBCmdWithEnv env err [NodeId]
 mkNodeWithParent NodeUser (Just pId) uid  _ = nodeError $ NodeCreationFailed $ UserParentAlreadyExists uid pId
 
 ------------------------------------------------------------------------
@@ -75,7 +75,7 @@ mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
                                     -> Maybe ParentId
                                     -> UserId
                                     -> Name
-                                    -> DBCmd' env err [NodeId]
+                                    -> DBCmdWithEnv env err [NodeId]
 mkNodeWithParent_ConfigureHyperdata Notes (Just i) uId name =
   mkNodeWithParent_ConfigureHyperdata' Notes (Just i) uId name
 
@@ -107,7 +107,7 @@ mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
                                      -> Maybe ParentId
                                      -> UserId
                                      -> Name
-                                     -> DBCmd' env err [NodeId]
+                                     -> DBCmdWithEnv env err [NodeId]
 mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
   nodeId <- case nt of
      Notes -> insertNode Notes (Just name)   Nothing i uId

src/Gargantext/Database/Action/Share.hs

@@ -44,7 +44,7 @@ data ShareNodeWith = ShareNodeWith_User !NodeType !User
                    | ShareNodeWith_Node !NodeType !NodeId
 
 ------------------------------------------------------------------------
-deleteMemberShip :: HasNodeError err => [(SharedFolderId, TeamNodeId)] -> Cmd err [Int]
+deleteMemberShip :: HasNodeError err => [(SharedFolderId, TeamNodeId)] -> DBCmdExtra err [Int]
 deleteMemberShip xs = mapM (\(s,t) -> deleteNodeNode s t) xs
 
 ------------------------------------------------------------------------
@@ -56,7 +56,7 @@ type TeamNodeId     = NodeId
 -- Result gives the username and its SharedFolderId that has to be eventually
 -- used for the membership
 membersOf :: HasNodeError err
-          => TeamNodeId -> Cmd err [(Text, SharedFolderId)]
+          => TeamNodeId -> DBCmdExtra err [(Text, SharedFolderId)]
 membersOf nId = do
   res <- runOpaQuery $ membersOfQuery nId
   pure $ catMaybes (uncurryMaybe <$> res)
@@ -91,7 +91,7 @@ shareNodeWith :: HasNodeError err
               -> NodeId
               -- ^ The target node we would like to share, it has
               -- to be a 'NodeFolderShared'.
-              -> Cmd err Int
+              -> DBCmdExtra err Int
 shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
   nodeToCheck <- getNode   n
   userIdCheck <- getUserId u
@@ -125,7 +125,7 @@ shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
 shareNodeWith _ _ = errorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"
 
 ------------------------------------------------------------------------
-getFolderId :: HasNodeError err => User -> NodeType -> Cmd err NodeId
+getFolderId :: HasNodeError err => User -> NodeType -> DBCmdExtra err NodeId
 getFolderId u nt = do
   rootId <- getRootId u
   s <- getNodesWith rootId HyperdataAny (Just nt) Nothing Nothing
@@ -136,12 +136,12 @@ getFolderId u nt = do
 ------------------------------------------------------------------------
 type TeamId = NodeId
 
-delFolderTeam :: HasNodeError err => User -> TeamId -> Cmd err Int
+delFolderTeam :: HasNodeError err => User -> TeamId -> DBCmdExtra err Int
 delFolderTeam u nId = do
   folderSharedId <- getFolderId u NodeFolderShared
   deleteNodeNode folderSharedId nId
 
 unshare :: HasNodeError err
         => ParentId -> NodeId
-        -> Cmd err Int
+        -> DBCmdExtra err Int
 unshare p n = deleteNodeNode p n

src/Gargantext/Database/Action/User/New.hs

@@ -34,7 +34,7 @@ import Gargantext.Core.Mail.Types (HasMail, mailSettings)
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow (getOrMkRoot)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, DBCmd, CmdM, DBCmd')
+import Gargantext.Database.Prelude (DBCmd, DBCmdExtra, IsDBCmdExtra, DBCmdWithEnv)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..), nodeError, NodeError(..))
 import Gargantext.Database.Query.Table.User
 import Gargantext.Prelude
@@ -45,7 +45,7 @@ import qualified Data.List.NonEmpty as NE
 ------------------------------------------------------------------------
 -- | Creates a new 'User' from the input 'EmailAddress', which needs to
 -- be valid (i.e. a valid username needs to be inferred via 'guessUsername').
-newUser :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env)
+newUser :: (IsDBCmdExtra env err m, MonadRandom m, HasNodeError err, HasMail env)
         => EmailAddress
         -> m UserId
 newUser emailAddress = do
@@ -62,7 +62,7 @@ newUser emailAddress = do
 -- use 'newUser' instead for standard Gargantext code.
 new_user :: (HasNodeError err)
          => NewUser GargPassword
-         -> DBCmd' env err UserId
+         -> DBCmdWithEnv env err UserId
 new_user rq = do
   (uid NE.:| _) <- new_users (rq NE.:| [])
   pure uid
@@ -75,14 +75,14 @@ new_user rq = do
 new_users :: (HasNodeError err)
           => NonEmpty (NewUser GargPassword)
           -- ^ A list of users to create.
-          -> DBCmd' env err (NonEmpty UserId)
+          -> DBCmdWithEnv env err (NonEmpty UserId)
 new_users us = do
   us'   <- liftBase        $ mapM toUserHash us
   void  $ insertUsers      $ NE.map toUserWrite us'
   mapM (fmap fst . getOrMkRoot) $ NE.map  (\u -> UserName   (_nu_username u)) us
 
 ------------------------------------------------------------------------
-newUsers :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env)
+newUsers :: (IsDBCmdExtra env err m, MonadRandom m, HasNodeError err, HasMail env)
          => NonEmpty EmailAddress
          -> m (NonEmpty UserId)
 newUsers us = do
@@ -109,7 +109,7 @@ guessUserName n = case splitOn "@" n of
 
 ------------------------------------------------------------------------
 newUsers' :: (HasNodeError err)
-         => MailConfig -> NonEmpty (NewUser GargPassword) -> DBCmd' env err (NonEmpty UserId)
+         => MailConfig -> NonEmpty (NewUser GargPassword) -> DBCmdWithEnv env err (NonEmpty UserId)
 newUsers' cfg us = do
   us' <- liftBase         $ mapM toUserHash  us
   void $ insertUsers      $ NE.map  toUserWrite us'
@@ -121,7 +121,7 @@ newUsers' cfg us = do
 ------------------------------------------------------------------------
 -- | Updates a user's password, notifying the user via email, if necessary.
 updateUser :: HasNodeError err
-            => SendEmail -> MailConfig -> NewUser GargPassword -> Cmd err Int64
+            => SendEmail -> MailConfig -> NewUser GargPassword -> DBCmdExtra err Int64
 updateUser (SendEmail send) cfg u = do
   u' <- liftBase     $ toUserHash   u
   n  <- updateUserDB $ toUserWrite  u'
@@ -129,7 +129,7 @@ updateUser (SendEmail send) cfg u = do
   pure n
 
 ------------------------------------------------------------------------
-_updateUsersPassword :: (CmdM env err m, MonadRandom m, HasNodeError err, HasMail env)
+_updateUsersPassword :: (IsDBCmdExtra env err m, MonadRandom m, HasNodeError err, HasMail env)
          => [EmailAddress] -> m Int64
 _updateUsersPassword us = do
   us' <- mapM (\ea -> mkNewUser ea . GargPassword <$> gargPass) us

src/Gargantext/Database/Prelude.hs

@@ -9,12 +9,50 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ConstraintKinds     #-}
+{-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
-
-module Gargantext.Database.Prelude where
+{-# LANGUAGE TupleSections       #-}
+
+module Gargantext.Database.Prelude
+  ( -- * Types and Constraints
+    -- $typesAndConstraints
+    --
+    -- ** Environment Constraints
+    HasConnectionPool(..)
+  , IsDBEnv
+  , IsDBEnvExtra
+    -- ** Command Monad Constraints
+  , IsCmd
+  , IsDBCmd
+  , IsDBCmdExtra
+    -- ** Existential Versions of the Above Constraints, for Convenience
+  , Cmd
+  , CmdRandom
+  , DBCmd
+  , DBCmdWithEnv
+  , DBCmdExtra
+    -- ** Miscellaneous Type(s)
+  , JSONB
+    -- * Functions
+    -- ** Executing DB Queries
+    -- *** PostgreSQL.Simple
+  , execPGSQuery
+  , runPGSQuery
+  , runPGSQuery_
+    -- *** Opaleye
+  , runOpaQuery
+  , runCountOpaQuery
+    -- ** Other Functions
+  , runCmd
+  , createDBIfNotExists
+  , dbCheck
+  , formatPGSQuery
+  , fromField'
+  , mkCmd
+  , restrictMaybe
+  )
+where
 
 import Control.Exception.Safe (throw)
 import Control.Lens (Getter, view)
@@ -35,79 +73,107 @@ import Gargantext.Core.Config (HasConfig(..))
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Prelude
-import Opaleye (Unpackspec, showSql, FromFields, Select, runSelect, SqlJsonb, DefaultFromField, toFields, matchMaybe, MaybeFields)
+import Opaleye (FromFields, Select, runSelect, SqlJsonb, DefaultFromField, toFields, matchMaybe, MaybeFields)
 import Opaleye.Aggregate (countRows)
 import Opaleye.Internal.Constant qualified
 import Opaleye.Internal.Operators qualified
 import Shelly qualified as SH
 
--------------------------------------------------------
+
+-- $typesAndConstraints
+--
+-- The names of the constraints and types in this module are chosen based on
+-- the following guidelines:
+-- * By default, constraints are relatively lenient. Stricter constraints are
+--   obtained by appending the `Extra` suffix to the minimal constraint name.
+-- * `IsDBEnv(Extra)` applies to the environment; the basic constraint allows
+--   access to the database, and the `Extra` variant offers some more
+--   capabilities such as access to mail.
+-- * `IsCmd` is the basic constraint for command monads. Append `DB` to it to get
+--   a monad of commands that can talk to the database. Append `Extra` to get
+--   the ability to send mail, make use of the NLP server and deal with central
+--   exchange notifications. Append `Random` to get access to randomness.
+-- * Existential versions of the constraints bear the same name as the constraint
+--   they are based on, but without the `Is` prefix.
+
 class HasConnectionPool env where
   connPool :: Getter env (Pool Connection)
 
 instance HasConnectionPool (Pool Connection) where
   connPool = identity
 
--------------------------------------------------------
-type JSONB = DefaultFromField SqlJsonb
--------------------------------------------------------
-
-type CmdM'' env err m =
-  ( MonadReader     env     m
-  , MonadError          err m
-  , MonadBaseControl IO     m
-  , MonadRandom             m
-  )
-
-type CmdM' env err m =
-  ( MonadReader     env     m
-  , MonadError          err m
-  , MonadBaseControl IO     m
-  )
-
--- | If possible, try to not add more constraints here. When performing
+-- | The most basic constraints for an environment with a database.
+-- If possible, try to not add more constraints here. When performing
 -- a query/update on the DB, one shouldn't need more than being able to
 -- fetch from the underlying 'env' the connection pool and access the
 -- 'GargConfig' for some sensible defaults to store into the DB.
-type DbCommon env =
+type IsDBEnv env =
   ( HasConnectionPool env
   , HasConfig         env
   )
 
-type CmdCommon env =
-  ( DbCommon          env
-  , HasConfig         env
-  , HasMail           env
-  , HasNLPServer      env
-  , CET.HasCentralExchangeNotification env )
-
-type CmdM env err m =
-  ( CmdM'     env err m
-  , CmdCommon env
+-- | Constraints for a full-fledged environment, with a database, mail exchange,
+-- NLP processing, notifications.
+type IsDBEnvExtra env =
+  ( IsDBEnv                            env
+  , HasMail                            env
+  , HasNLPServer                       env
+  , CET.HasCentralExchangeNotification env
   )
 
-type CmdRandom env err m =
-  ( CmdM'             env err m
-  , DbCommon          env
-  , MonadRandom       m
-  , HasMail           env
+-- | The most general constraints for commands. To interact with the database,
+-- or access extra features (such as sending mail), you'll need to add some more
+-- constraints (see the rest of this module)
+type IsCmd env err m =
+  ( MonadReader     env     m
+  , MonadError          err m
+  , MonadBaseControl IO     m
   )
 
-type Cmd''  env err a = forall m.     CmdM''    env err m => m a
-type Cmd'   env err a = forall m.     CmdM'     env err m => m a
-type Cmd        err a = forall m env. CmdM      env err m => m a
-type CmdR       err a = forall m env. CmdRandom env err m => m a
-type DBCmd' env err a = forall m.     DbCmd'    env err m => m a
-type DBCmd      err a = forall m env. DbCmd'    env err m => m a
-
 -- | Only the /minimum/ amount of class constraints required
 -- to use the Gargantext Database. It's important, to ease testability,
 -- that these constraints stays as few as possible.
-type DbCmd' env err m = (
-    CmdM' env err m
-  , DbCommon env
+type IsDBCmd env err m =
+  ( IsCmd env err m
+  , IsDBEnv env
   )
 
+-- | Full-fledged command class. Types in this class provide commands that can
+-- interact with the database, perform NLP processing, etc.
+type IsDBCmdExtra env err m =
+  ( IsCmd        env err m
+  , IsDBEnvExtra env
+  )
+
+-- | Basic command with access to randomness. It feels a little ad hoc to have
+-- such a constraint instead of substituting it (and its counterpart existential
+-- type `CmdRandom`) with its definition every time it appears in the codebase,
+-- but I tried to doing that substitution and it wasn't so easy.
+type IsCmdRandom env err m =
+  ( IsCmd env err m
+  , MonadRandom   m
+  )
+
+-- | Barebones command type, without any built-in ability to interact with the
+-- database or do stuff like email exchanges.
+type Cmd env err a = forall m. IsCmd env err m => m a
+
+-- | Basic command type with access to randomness
+type CmdRandom env err a = forall m. IsCmdRandom  env err m => m a
+
+-- | Command type that allows for interaction with the database.
+type DBCmd err a = forall m env. IsDBCmd env err m => m a
+
+-- | Command type that allows for interaction with the database. Similar to
+-- `DBCmd`, except you can constraint the environment type some more.
+type DBCmdWithEnv env err a = forall m. IsDBCmd env err m => m a
+
+-- | Full-fledged command types, with access to the database, mail, NLP
+-- processing and central exchange notifications.
+type DBCmdExtra err a = forall m env. IsDBCmdExtra env err m => m a
+
+type JSONB = DefaultFromField SqlJsonb
+
 fromInt64ToInt :: Int64 -> Int
 fromInt64ToInt = fromIntegral
 
@@ -118,7 +184,7 @@ mkCmd k = do
   liftBase $ withResource pool (liftBase . k)
 
 runCmd :: env
-       -> Cmd'' env err a
+       -> CmdRandom env err a
        -> IO (Either err a)
 runCmd env m = runExceptT $ runReaderT m env
 
@@ -136,10 +202,6 @@ runCountOpaQuery q = do
 formatPGSQuery :: PGS.ToRow a => PGS.Query -> a -> DBCmd err DB.ByteString
 formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
 
--- TODO use runPGSQueryDebug everywhere
-runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> DBCmd err [b]
-runPGSQuery' q a = mkCmd $ \conn -> PGS.query conn q a
-
 runPGSQuery :: ( PGS.FromRow r, PGS.ToRow q )
             => PGS.Query -> q -> DBCmd err [r]
 runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
@@ -149,22 +211,6 @@ runPGSQuery q a = mkCmd $ \conn -> catch (PGS.query conn q a) (printError conn)
       hPutStrLn stderr q'
       throw (SomeException e)
 
-{-
--- TODO
-runPGSQueryFold :: ( CmdM env err m
-               , PGS.FromRow r
-               )
-               => PGS.Query -> a -> (a -> r -> IO a) -> m a
-runPGSQueryFold q initialState consume = mkCmd $ \conn -> catch (PGS.fold_ conn initialState consume) (printError conn)
-  where
-    printError c (SomeException e) = do
-      q' <- PGS.formatQuery c q
-      hPutStrLn stderr q'
-      throw (SomeException e)
--}
-
-
-
 -- | TODO catch error
 runPGSQuery_ :: ( PGS.FromRow r )
              => PGS.Query -> DBCmd err [r]
@@ -177,10 +223,6 @@ runPGSQuery_ q = mkCmd $ \conn -> catch (PGS.query_ conn q) printError
 execPGSQuery :: PGS.ToRow a => PGS.Query -> a -> DBCmd err Int64
 execPGSQuery q a = mkCmd $ \conn -> PGS.execute conn q a
 
-------------------------------------------------------------------------
-
--- connectGargandb :: SettingsFile -> IO Connection
--- connectGargandb sf = readConfig sf >>= \params -> connect (DBConfig.unTOMLConnectInfo params)
 
 fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DB.ByteString -> Conversion b
 fromField' field mb = do
@@ -194,9 +236,6 @@ fromField' field mb = do
                                       , show v
                                       ]
 
-printSqlOpa :: Default Unpackspec a a => Select a -> IO ()
-printSqlOpa = putStrLn . maybe "Empty query" identity . showSql
-
 dbCheck :: DBCmd err Bool
 dbCheck = do
   r :: [PGS.Only Text] <- runPGSQuery_ "select username from public.auth_user"

src/Gargantext/Database/Query/Table/Node/Update.hs

@@ -24,7 +24,7 @@ import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Admin.Config ()
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, DBCmd, runPGSQuery)
+import Gargantext.Database.Prelude (DBCmd, DBCmdExtra, runPGSQuery)
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node (getParentId, getNode, getUserRootPublicNode)
 import Gargantext.Database.Query.Table.NodeNode (isNodeReadOnly, SourceId (..), TargetId(..), publishNode, unpublishNode)
@@ -48,7 +48,7 @@ unOnly :: Only a -> a
 unOnly (Only a) = a
 
 -- | Prefer this, because it notifies parents of the node change
-update :: HasNodeError err => UserId -> Update -> Cmd err [Int]
+update :: HasNodeError err => UserId -> Update -> DBCmdExtra err [Int]
 update _loggedInUserId (Rename nId newName) = do
   ret <- rename_db_update nId newName
   mpId <- getParentId nId
@@ -94,12 +94,12 @@ update loggedInUserId (Move sourceId targetId) = do
 
       pure ids
 
-publish :: HasNodeError err => UserId -> NodeId -> NodePublishPolicy -> Cmd err Int
+publish :: HasNodeError err => UserId -> NodeId -> NodePublishPolicy -> DBCmdExtra err Int
 publish loggedInUserId sourceId policy = do
   targetId <- _node_id <$> getUserRootPublicNode loggedInUserId
   publish_node (SourceId sourceId) (TargetId targetId) policy
 
-publish_node :: HasNodeError err => SourceId -> TargetId -> NodePublishPolicy -> Cmd err Int
+publish_node :: HasNodeError err => SourceId -> TargetId -> NodePublishPolicy -> DBCmdExtra err Int
 publish_node (SourceId sourceId) (TargetId targetId) policy = do
   sourceNode <- getNode sourceId
   targetNode <- getNode targetId
@@ -121,7 +121,7 @@ publish_node (SourceId sourceId) (TargetId targetId) policy = do
 
 
 -- Issue #400, for now we support only publishing corpus nodes
-check_publish_source_type_allowed :: HasNodeError err => SourceId -> TargetId -> NodeType -> Cmd err ()
+check_publish_source_type_allowed :: HasNodeError err => SourceId -> TargetId -> NodeType -> DBCmdExtra err ()
 check_publish_source_type_allowed (SourceId nId) (TargetId tId) = \case
   NodeCorpus   -> pure ()
   NodeCorpusV3 -> pure ()

src/Gargantext/Database/Query/Tree/Root.hs

@@ -22,7 +22,7 @@ import Gargantext.Database.Action.User (getUserId, getUsername)
 import Gargantext.Database.Admin.Config ( corpusMasterName, userMaster )
 import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (runOpaQuery, DBCmd, DBCmd')
+import Gargantext.Database.Prelude (runOpaQuery, DBCmd, DBCmdWithEnv)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.User (queryUserTable, UserPoly(..))
@@ -44,7 +44,7 @@ getRoot = runOpaQuery . selectRoot
 
 getOrMkRoot :: (HasNodeError err)
             => User
-            -> DBCmd' env err (UserId, RootId)
+            -> DBCmdWithEnv env err (UserId, RootId)
 getOrMkRoot user = do
   userId <- getUserId user
 
@@ -80,7 +80,7 @@ userFromMkCorpusUser (MkCorpusUserNormalCorpusName u _cname) = u
 getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a)
                       => MkCorpusUser
                       -> Maybe a
-                      -> DBCmd' env err (UserId, RootId, CorpusId)
+                      -> DBCmdWithEnv env err (UserId, RootId, CorpusId)
 getOrMkRootWithCorpus MkCorpusUserMaster c = do
   (userId, rootId) <- getOrMkRoot (UserName userMaster)
   corpusId'' <- do
@@ -121,7 +121,7 @@ mkCorpus cName c rootId userId = do
 
 mkRoot :: (HasNodeError err)
        => User
-       -> DBCmd' env err [RootId]
+       -> DBCmdWithEnv env err [RootId]
 mkRoot user = do
 
   -- TODO