[refactor] yet more Cmd -> DBCmd refactoring

src/Gargantext/API/Admin/Auth.hs

@@ -58,7 +58,7 @@ import Gargantext.Core.Mail.Types (mailSettings)
 import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node (NodeId(..))
-import Gargantext.Database.Prelude (Cmd', CmdM, CmdCommon)
+import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
 import Gargantext.Database.Query.Table.User
 import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
 import Gargantext.Database.Query.Tree.Root (getRoot)
@@ -79,7 +79,8 @@ import Gargantext.API.Auth.PolicyCheck
 
 -- | Main functions of authorization
 
-makeTokenForUser :: (HasSettings env, HasJoseError err)
+makeTokenForUser :: ( HasSettings env
+                    , HasJoseError err )
                  => NodeId -> Cmd' env err Token
 makeTokenForUser uid = do
   jwtS <- view $ settings . jwtSettings
@@ -88,10 +89,10 @@ makeTokenForUser uid = do
   either joseError (pure . toStrict . LE.decodeUtf8) e
   -- TODO not sure about the encoding...
 
-checkAuthRequest :: ( HasSettings env, CmdCommon env, HasJoseError err)
+checkAuthRequest :: ( HasSettings env, HasJoseError err, DbCmd' env err m )
                  => Username
                  -> GargPassword
-                 -> Cmd' env err CheckAuth
+                 -> m CheckAuth
 checkAuthRequest couldBeEmail (GargPassword p) = do
   -- Sometimes user put email instead of username
   -- hence we have to check before
@@ -113,8 +114,8 @@ checkAuthRequest couldBeEmail (GargPassword p) = do
               token <- makeTokenForUser uid
               pure $ Valid token uid userLight_id
 
-auth :: (HasSettings env, CmdCommon env, HasJoseError err)
-     => AuthRequest -> Cmd' env err AuthResponse
+auth :: (HasSettings env, HasJoseError err, DbCmd' env err m)
+     => AuthRequest -> m AuthResponse
 auth (AuthRequest u p) = do
   checkAuthRequest' <- checkAuthRequest u p
   case checkAuthRequest' of
@@ -135,7 +136,7 @@ authCheck _env (BasicAuthData login password) = pure $
   maybe Indefinite Authenticated $ TODO
 -}
 
-withAccessM :: (CmdM env err m, HasServerError err)
+withAccessM :: ( DbCmd' env err m )
             => AuthenticatedUser
             -> PathId
             -> m a
@@ -143,7 +144,6 @@ withAccessM :: (CmdM env err m, HasServerError err)
 withAccessM (AuthenticatedUser uId) (PathNode id) m = do
   d <- id `isDescendantOf` uId
   if d then m else m -- serverError err401
-
 withAccessM (AuthenticatedUser uId) (PathNodeNode cId docId) m = do
   _a <- isIn cId docId -- TODO use one query for all ?
   _d <- cId `isDescendantOf` uId

src/Gargantext/API/GraphQL/User.hs

@@ -4,24 +4,21 @@
 module Gargantext.API.GraphQL.User where
 
 import Data.Maybe (listToMaybe)
-import Data.Morpheus.Types
-  ( GQLType
-  , lift
-  )
+import Data.Morpheus.Types ( GQLType , lift )
 import Data.Text (Text)
 import GHC.Generics (Generic)
+import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.Types (HasSettings)
+import Gargantext.API.Auth.PolicyCheck
+import Gargantext.API.GraphQL.PolicyCheck
 import Gargantext.API.GraphQL.Types
+import Gargantext.Core.Types.Individu qualified as Individu
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..))
 import Gargantext.Database.Admin.Types.Node (NodeId(..))
 import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Query.Table.User qualified as DBUser
 import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
-import qualified Gargantext.Core.Types.Individu as Individu
-import qualified Gargantext.Database.Query.Table.User as DBUser
-import Gargantext.API.Admin.Auth.Types
-import Gargantext.API.Auth.PolicyCheck
-import Gargantext.API.GraphQL.PolicyCheck
 
 data User m = User
   { u_email     :: Text
@@ -54,8 +51,7 @@ resolveUsers autUser mgr UserArgs { user_id } = do
   withPolicy autUser mgr alwaysAllow $ dbUsers user_id
 
 -- | Inner function to fetch the user from DB.
-dbUsers
-  :: (CmdCommon env)
+dbUsers :: (CmdCommon env)
         => Int -> GqlM e env [User (GqlM e env)]
 dbUsers user_id = lift (map toUser <$> DBUser.getUsersWithId (Individu.RootId $ NodeId user_id))
 

src/Gargantext/API/Table.hs

@@ -35,12 +35,8 @@ import Data.Aeson.TH (deriveJSON)
 import Data.Maybe
 import Data.Swagger
 import Data.Text (Text())
+import Data.Text qualified as T
 import GHC.Generics (Generic)
-import Prelude
-import Servant
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
-
 import Gargantext.API.HashedResponse
 import Gargantext.API.Ngrams.Types (TabType(..))
 import Gargantext.API.Prelude (GargServer)
@@ -56,7 +52,10 @@ import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDoc
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Prelude
 import Gargantext.System.Logging
-import qualified Data.Text as T
+import Prelude
+import Servant
+import Test.QuickCheck (elements)
+import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
 
 ------------------------------------------------------------------------
 
@@ -156,7 +155,7 @@ getTableHashApi cId tabType = do
   HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing
   pure h
 
-searchInCorpus' :: (CmdM env err m, MonadLogger m)
+searchInCorpus' :: (DbCmd' env err m, MonadLogger m)
                 => CorpusId
                 -> Bool
                 -> RawQuery
@@ -201,7 +200,7 @@ getTable' :: HasNodeError err
           -> Maybe OrderBy
           -> Maybe Text
           -> Maybe Text
-          -> Cmd err [FacetDoc]
+          -> DBCmd err [FacetDoc]
 getTable' cId ft o l order query year =
   case ft of
     (Just Docs)      -> runViewDocuments cId False o l order query year
@@ -213,7 +212,7 @@ getTable' cId ft o l order query year =
 
 getPair :: ContactId -> Maybe TabType
          -> Maybe Offset  -> Maybe Limit
-         -> Maybe OrderBy -> Cmd err [FacetDoc]
+         -> Maybe OrderBy -> DBCmd err [FacetDoc]
 getPair cId ft o l order =
   case ft of
     (Just Docs)  -> runViewAuthorsDoc cId False o l order

src/Gargantext/Database.hs

@@ -36,7 +36,7 @@ import Gargantext.Database.Query.Table.NodeNode
 
 
 class InsertDB a where
-  insertDB :: a -> Cmd err Int
+  insertDB :: a -> DBCmd err Int
 
 {-
 class DeleteDB a where

src/Gargantext/Database/Action/Learn.hs

@@ -15,19 +15,19 @@ Portability : POSIX
 module Gargantext.Database.Action.Learn
   where
 
+import Data.List qualified as List
 import Data.Maybe
 import Data.Text (Text)
+import Data.Text qualified as Text
 import Gargantext.Core
+import Gargantext.Core.Text.Learn
 import Gargantext.Core.Types.Query (Offset, Limit(..))
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Facet
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
-import Gargantext.Database.Prelude (Cmd)
 import Gargantext.Prelude
-import Gargantext.Core.Text.Learn
-import qualified Data.List as List
-import qualified Data.Text as Text
 
 data FavOrTrash = IsFav | IsTrash
   deriving (Eq)
@@ -35,14 +35,14 @@ data FavOrTrash = IsFav | IsTrash
 
 moreLike :: (HasDBid NodeType, HasNodeError err)
          => CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
-         -> FavOrTrash -> Cmd err [FacetDoc]
+         -> FavOrTrash -> DBCmd err [FacetDoc]
 moreLike cId o _l order ft = do
   priors <- getPriors ft cId
   moreLikeWith cId o (Just 3) order ft priors
 
 ---------------------------------------------------------------------------
 getPriors :: (HasDBid NodeType, HasNodeError err)
-          => FavOrTrash -> CorpusId -> Cmd err (Events Bool)
+          => FavOrTrash -> CorpusId -> DBCmd err (Events Bool)
 getPriors ft cId = do
 
   docs_fav   <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 2)
@@ -60,7 +60,7 @@ getPriors ft cId = do
 
 moreLikeWith :: (HasDBid NodeType, HasNodeError err)
              => CorpusId   -> Maybe Offset -> Maybe Limit -> Maybe OrderBy
-             -> FavOrTrash -> Events Bool  -> Cmd err [FacetDoc]
+             -> FavOrTrash -> Events Bool  -> DBCmd err [FacetDoc]
 moreLikeWith cId o l order ft priors = do
 
   docs_test  <- filter (\(FacetDoc _ _ _ _ f _ _) -> f == Just 1)

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

@@ -135,12 +135,12 @@ _updateUsersPassword us = do
   pure 1
 
 ------------------------------------------------------------------------
-_rmUser :: HasNodeError err => User -> Cmd err Int64
+_rmUser :: HasNodeError err => User -> DBCmd err Int64
 _rmUser (UserName un) = deleteUsers [un]
 _rmUser _ = nodeError NotImplYet
 
 ------------------------------------------------------------------------
 -- TODO
-_rmUsers :: HasNodeError err => [User] -> Cmd err Int64
+_rmUsers :: HasNodeError err => [User] -> DBCmd err Int64
 _rmUsers [] = pure 0
 _rmUsers _  = undefined

src/Gargantext/Database/Prelude.hs

@@ -144,17 +144,15 @@ runCountOpaQuery q = do
   -- countRows is guaranteed to return a list with exactly one row so DL.head is safe here
   pure $ fromInt64ToInt $ DL.head counts
 
-formatPGSQuery :: PGS.ToRow a => PGS.Query -> a -> Cmd err DB.ByteString
+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 -> Cmd err [b]
+runPGSQuery' :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> DBCmd err [b]
 runPGSQuery' q a = mkCmd $ \conn -> PGS.query conn q a
 
-runPGSQuery :: ( DbCmd' env err m
-               , PGS.FromRow r, PGS.ToRow q
-               )
-               => PGS.Query -> q -> m [r]
+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)
   where
     printError c (SomeException e) = do
@@ -179,10 +177,8 @@ runPGSQueryFold q initialState consume = mkCmd $ \conn -> catch (PGS.fold_ conn
 
 
 -- | TODO catch error
-runPGSQuery_ :: ( CmdM env err m
-               , PGS.FromRow r
-               )
-               => PGS.Query -> m [r]
+runPGSQuery_ :: ( PGS.FromRow r )
+             => PGS.Query -> DBCmd err [r]
 runPGSQuery_ q = mkCmd $ \conn -> catch (PGS.query_ conn q) printError
   where
     printError (SomeException e) = do
@@ -227,7 +223,7 @@ fromField' field mb = do
 printSqlOpa :: Default Unpackspec a a => Select a -> IO ()
 printSqlOpa = putStrLn . maybe "Empty query" identity . showSql
 
-dbCheck :: CmdM env err m => m Bool
+dbCheck :: DBCmd err Bool
 dbCheck = do
   r :: [PGS.Only Text] <- runPGSQuery_ "select username from public.auth_user"
   case r of

src/Gargantext/Database/Query/Facet.hs

@@ -70,7 +70,7 @@ runViewAuthorsDoc :: HasDBid NodeType
                   -> Maybe Offset
                   -> Maybe Limit
                   -> Maybe OrderBy
-                  -> Cmd err [FacetDoc]
+                  -> DBCmd err [FacetDoc]
 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
   where
     ntId = NodeDocument
@@ -125,11 +125,11 @@ runViewDocuments :: (HasDBid NodeType, HasNodeError err)
                  -> Maybe OrderBy
                  -> Maybe Text
                  -> Maybe Text
-                 -> Cmd err [FacetDoc]
+                 -> DBCmd err [FacetDoc]
 runViewDocuments cId t o l order query year = do
     listId <- defaultList cId
 
-    res <- runOpaQuery $ filterWith' o l order (sqlQuery listId) :: Cmd err [FacetDocAgg']
+    res <- runOpaQuery $ filterWith' o l order (sqlQuery listId) :: DBCmd err [FacetDocAgg']
     pure $ remapNgramsCount <$> res
   where
     sqlQuery lId = viewDocuments cId lId t (toDBid NodeDocument) query year
@@ -140,7 +140,7 @@ runViewDocuments cId t o l order query year = do
                , .. }
 
 runCountDocuments :: (HasDBid NodeType, HasNodeError err)
-                  => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> Cmd err Int
+                  => CorpusId -> IsTrash -> Maybe Text -> Maybe Text -> DBCmd err Int
 runCountDocuments cId t mQuery mYear = do
   listId <- defaultList cId
   runCountOpaQuery (sqlQuery listId)

src/Gargantext/Database/Query/Table/Ngrams.hs

@@ -28,7 +28,7 @@ import Data.HashMap.Strict (HashMap)
 import Data.Map.Strict (Map)
 import Data.Text (Text)
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (runOpaQuery, Cmd, formatPGSQuery, runPGSQuery, DBCmd)
+import Gargantext.Database.Prelude (runOpaQuery, formatPGSQuery, runPGSQuery, DBCmd)
 import Gargantext.Database.Query.Join (leftJoin3)
 import Gargantext.Database.Query.Table.ContextNodeNgrams2
 import Gargantext.Database.Query.Table.NodeNgrams (queryNodeNgramsTable)
@@ -45,7 +45,7 @@ import qualified Database.PostgreSQL.Simple as PGS
 queryNgramsTable :: Select NgramsRead
 queryNgramsTable = selectTable ngramsTable
 
-selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> Cmd err [Text]
+selectNgramsByDoc :: [ListId] -> DocId -> NgramsType -> DBCmd err [Text]
 selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
   where
 
@@ -65,10 +65,10 @@ selectNgramsByDoc lIds dId nt = runOpaQuery (query lIds dId nt)
       returnA  -< ng^.ngrams_terms
 
 
-_postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int
+_postNgrams :: CorpusId -> DocId -> [Text] -> DBCmd err Int
 _postNgrams = undefined
 
-_dbGetNgramsDb :: Cmd err [NgramsDB]
+_dbGetNgramsDb :: DBCmd err [NgramsDB]
 _dbGetNgramsDb = runOpaQuery queryNgramsTable
 
 
@@ -85,7 +85,7 @@ insertNgrams' ns = runPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
   where
     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
 
-_insertNgrams_Debug :: [(Text, Size)] -> Cmd err ByteString
+_insertNgrams_Debug :: [(Text, Size)] -> DBCmd err ByteString
 _insertNgrams_Debug ns = formatPGSQuery queryInsertNgrams (PGS.Only $ Values fields ns)
   where
     fields = map (\t -> QualifiedIdentifier Nothing t) ["text", "int4"]
@@ -111,13 +111,13 @@ queryInsertNgrams = [sql|
 
 
 --------------------------------------------------------------------------
-selectNgramsId :: [Text] -> Cmd err (Map NgramsId Text)
+selectNgramsId :: [Text] -> DBCmd err (Map NgramsId Text)
 selectNgramsId ns =
   if List.null ns
      then pure Map.empty
      else Map.fromList <$> map (\(Indexed i t) -> (i, t)) <$> (selectNgramsId' ns)
 
-selectNgramsId' :: [Text] -> Cmd err [Indexed Int Text]
+selectNgramsId' :: [Text] -> DBCmd err [Indexed Int Text]
 selectNgramsId' ns = runPGSQuery querySelectNgramsId ( PGS.Only
                                                      $ Values fields ns
                                                      )

src/Gargantext/Database/Query/Table/NgramsPostag.hs

@@ -24,7 +24,7 @@ import Data.Hashable (Hashable)
 import Data.Text (Text)
 import Gargantext.Core
 import Gargantext.Core.Types
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, runPGSQuery_, DBCmd)
+import Gargantext.Database.Prelude (runPGSQuery, runPGSQuery_, DBCmd)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Prelude
 import Gargantext.Database.Query.Table.Ngrams
@@ -180,7 +180,7 @@ querySelectLems = [sql|
   |]
 
 -- | Insert Table
-createTable_NgramsPostag :: Cmd err [Int]
+createTable_NgramsPostag :: DBCmd err [Int]
 createTable_NgramsPostag = map (\(PGS.Only a) -> a)
                         <$> runPGSQuery_ queryCreateTable
   where

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

@@ -25,10 +25,8 @@ import Control.Lens (set, view)
 import Data.Aeson
 import Data.Maybe (fromMaybe)
 import Data.Text (Text)
+import Database.PostgreSQL.Simple qualified as PGS
 import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Opaleye hiding (FromField)
-import Prelude hiding (null, id, map, sum)
-
 import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Query (Limit, Offset)
@@ -39,8 +37,8 @@ import Gargantext.Database.Query.Filter (limit', offset')
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum, head)
-
-import qualified Database.PostgreSQL.Simple as PGS
+import Opaleye hiding (FromField)
+import Prelude hiding (null, id, map, sum)
 
 
 queryNodeSearchTable :: Select NodeSearchRead

src/Gargantext/Database/Query/Table/Node/Document/Add.hs

@@ -28,7 +28,7 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..))
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import GHC.Generics (Generic)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, formatPGSQuery, DBCmd)
+import Gargantext.Database.Prelude (runPGSQuery, formatPGSQuery, DBCmd)
 import Gargantext.Prelude
 
 ---------------------------------------------------------------------------
@@ -41,12 +41,12 @@ add pId ns = runPGSQuery queryAdd (Only $ Values fields inputData)
 
 -- | Adds a single document. Useful for debugging purposes, but
 -- not as efficient as adding documents in bulk via 'add'.
-add_one :: CorpusId -> ContextId -> Cmd err [Only Int]
+add_one :: CorpusId -> ContextId -> DBCmd err [Only Int]
 add_one pId ctxId = runPGSQuery queryAdd (Only $ Values fields [InputData pId ctxId])
   where
     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes
 
-add_debug :: CorpusId -> [ContextId] -> Cmd err ByteString
+add_debug :: CorpusId -> [ContextId] -> DBCmd err ByteString
 add_debug pId ns = formatPGSQuery queryAdd (Only $ Values fields inputData)
   where
     fields    = map (\t-> QualifiedIdentifier Nothing t) inputSqlTypes

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

@@ -19,7 +19,7 @@ import Database.PostgreSQL.Simple
 
 import Gargantext.Prelude
 import Gargantext.Core.Types (Name)
-import Gargantext.Database.Prelude
+import Gargantext.Database.Prelude (DBCmd, runPGSQuery)
 import Gargantext.Database.Admin.Types.Node (NodeId, ParentId)
 
 -- import Data.ByteString
@@ -39,7 +39,7 @@ unOnly :: Only a -> a
 unOnly (Only a) = a
 
 -- TODO-ACCESS
-update :: Update -> Cmd err [Int]
+update :: Update -> DBCmd err [Int]
 update (Rename nId name) = map unOnly <$> runPGSQuery "UPDATE nodes SET name=? where id=? returning id"
                                            (DT.take 255 name,nId)
 update (Move nId pId)    = map unOnly <$> runPGSQuery "UPDATE nodes SET parent_id= ? where id=? returning id"

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

@@ -22,7 +22,7 @@ import Gargantext.Prelude
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, mkCmd, DBCmd)
+import Gargantext.Database.Prelude (mkCmd, DBCmd)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 
@@ -49,7 +49,7 @@ updateHyperdataQuery i h = seq h' $ {- trace "updateHyperdataQuery: encoded JSON
 updateNodesWithType :: ( HasNodeError err
                        , HasDBid NodeType
                        , HyperdataC a
-                       ) => NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
+                       ) => NodeType -> proxy a -> (a -> a) -> DBCmd err [Int64]
 updateNodesWithType nt p f = do
   ns <- getNodesWithType nt p
   mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
@@ -61,7 +61,7 @@ updateNodeWithType :: ( HasNodeError err
                         -> NodeType
                         -> proxy a
                         -> (a -> a)
-                        -> Cmd err [Int64]
+                        -> DBCmd err [Int64]
 updateNodeWithType nId nt p f = do
   ns <- getNodeWithType nId nt p
   mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
@@ -71,7 +71,7 @@ updateNodeWithType nId nt p f = do
 updateNodesWithType_ :: ( HasNodeError err
                         , HyperdataC a
                         , HasDBid NodeType
-                        ) => NodeType -> a -> Cmd err [Int64]
+                        ) => NodeType -> a -> DBCmd err [Int64]
 updateNodesWithType_ nt h = do
   ns <- getNodesIdWithType nt
   mapM (\n -> updateHyperdata n h) ns

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

@@ -17,14 +17,14 @@ import Gargantext.Core
 import Gargantext.Core.Types (Name)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), defaultHyperdataUser)
 import Gargantext.Database.Admin.Types.Node (Node, NodeId(..), UserId, NodeType(..), pgNodeId)
-import Gargantext.Database.Prelude -- (fromField', Cmd)
+import Gargantext.Database.Prelude (DBCmd, runOpaQuery)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Schema.Node -- (Node(..))
 import Gargantext.Prelude
 import Opaleye (limit)
 
 
-getNodeUser :: NodeId -> Cmd err (Node HyperdataUser)
+getNodeUser :: NodeId -> DBCmd err (Node HyperdataUser)
 getNodeUser nId = do
     fromMaybe (panic $ "Node does not exist: " <> (cs $ show nId)) . headMay
              <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))

src/Gargantext/Database/Query/Table/NodeNgrams.hs

@@ -62,11 +62,9 @@ getCgramsId mapId nt t = case Map.lookup nt mapId of
   Just mapId' -> Map.lookup t mapId'
 
 
--- insertDb :: ListId -> Map NgramsType [NgramsElement] -> Cmd err [Result]
 listInsertDb :: Show a => ListId
              -> (ListId -> a -> [NodeNgramsW])
              -> a
-             -- -> Cmd err [Returning]
              -> DBCmd err (Map NgramsType (Map Text Int))
 listInsertDb l f ngs = Map.map Map.fromList
                     <$> Map.fromListWith (<>)

src/Gargantext/Database/Query/Table/NodeNodeNgrams.hs

@@ -23,7 +23,7 @@ module Gargantext.Database.Query.Table.NodeNodeNgrams
   where
 
 import Gargantext.Database.Admin.Types.Node (pgNodeId)
-import Gargantext.Database.Prelude (Cmd, mkCmd)
+import Gargantext.Database.Prelude (DBCmd, mkCmd)
 import Gargantext.Database.Schema.Ngrams (pgNgramsTypeId)
 import Gargantext.Database.Schema.NodeNodeNgrams
 import Gargantext.Database.Schema.Prelude
@@ -34,7 +34,7 @@ queryNodeNodeNgramsTable :: Query NodeNodeNgramsRead
 queryNodeNodeNgramsTable = selectTable nodeNodeNgramsTable
 
 -- | Insert utils
-insertNodeNodeNgrams :: [NodeNodeNgrams] -> Cmd err Int
+insertNodeNodeNgrams :: [NodeNodeNgrams] -> DBCmd err Int
 insertNodeNodeNgrams = insertNodeNodeNgramsW
                      . map (\(NodeNodeNgrams n1 n2 ng nt w) ->
                               NodeNodeNgrams (pgNodeId n1)
@@ -44,7 +44,7 @@ insertNodeNodeNgrams = insertNodeNodeNgramsW
                                              (sqlDouble w)
                                                   )
 
-insertNodeNodeNgramsW :: [NodeNodeNgramsWrite] -> Cmd err Int
+insertNodeNodeNgramsW :: [NodeNodeNgramsWrite] -> DBCmd err Int
 insertNodeNodeNgramsW nnnw =
   mkCmd $ \c -> fromIntegral <$> runInsert_ c insertNothing
     where

src/Gargantext/Database/Query/Table/User.hs

@@ -58,7 +58,7 @@ import Gargantext.Core.Types.Individu
 import qualified Gargantext.Prelude.Crypto.Auth as Auth
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataUser(..), hu_pubmed_api_key)
 import Gargantext.Database.Admin.Types.Node (NodeType(NodeUser), Node, NodeId(..), pgNodeId)
-import Gargantext.Database.Prelude
+import Gargantext.Database.Prelude (DBCmd, mkCmd, runOpaQuery)
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateNodeWithType)
 import Gargantext.Database.Schema.Node (NodeRead, node_hyperdata, queryNodeTable, node_id, node_user_id, node_typename)
 import Gargantext.Database.Schema.User
@@ -76,14 +76,14 @@ insertUsers us = mkCmd $ \c -> runInsert c insert
   where
     insert = Insert userTable us rCount Nothing
 
-deleteUsers :: [Username] -> Cmd err Int64
+deleteUsers :: [Username] -> DBCmd err Int64
 deleteUsers us = mkCmd $ \c -> runDelete_ c
                        $ Delete userTable
                                 (\user -> in_ (map sqlStrictText us) (user_username user))
                                 rCount
 
 -- Updates email or password only (for now)
-updateUserDB :: UserWrite -> Cmd err Int64
+updateUserDB :: UserWrite -> DBCmd err Int64
 updateUserDB us = mkCmd $ \c -> runUpdate_ c (updateUserQuery us)
   where
     updateUserQuery :: UserWrite -> Update Int64
@@ -119,7 +119,7 @@ toUserWrite (NewUser u m (Auth.PasswordHash p)) =
          , user_forgot_password_uuid = Nothing }
 
 ------------------------------------------------------------------
-getUsersWith :: Username -> Cmd err [UserLight]
+getUsersWith :: Username -> DBCmd err [UserLight]
 getUsersWith u = map toUserLight <$> runOpaQuery (selectUsersLightWith u)
 
 selectUsersLightWith :: Username -> Select UserRead
@@ -128,7 +128,7 @@ selectUsersLightWith u = proc () -> do
       restrict -< user_username row .== sqlStrictText u
       returnA  -< row
 
-getUsersWithEmail :: Text -> Cmd err [UserLight]
+getUsersWithEmail :: Text -> DBCmd err [UserLight]
 getUsersWithEmail e = map toUserLight <$> runOpaQuery (selectUsersLightWithEmail e)
 
 selectUsersLightWithEmail :: Text -> Select UserRead
@@ -137,7 +137,7 @@ selectUsersLightWithEmail e = proc () -> do
       restrict -< user_email row .== sqlStrictText e
       returnA  -< row
 
-getUsersWithForgotPasswordUUID :: UUID.UUID -> Cmd err [UserLight]
+getUsersWithForgotPasswordUUID :: UUID.UUID -> DBCmd err [UserLight]
 getUsersWithForgotPasswordUUID uuid = map toUserLight <$> runOpaQuery (selectUsersLightWithForgotPasswordUUID uuid)
 
 selectUsersLightWithForgotPasswordUUID :: UUID.UUID -> Select UserRead
@@ -173,7 +173,7 @@ queryUserTable = selectTable userTable
 
 ----------------------------------------------------------------------
 -- | Get hyperdata associated with user node.
-getUserHyperdata :: User -> Cmd err [HyperdataUser]
+getUserHyperdata :: User -> DBCmd err [HyperdataUser]
 getUserHyperdata (RootId uId) = do
   runOpaQuery (selectUserHyperdataWithId uId)
   where
@@ -195,7 +195,7 @@ getUserHyperdata _ = undefined
 
 
 -- | Same as `getUserHyperdata` but returns a `Node` type.
-getUserNodeHyperdata :: User -> Cmd err [Node HyperdataUser]
+getUserNodeHyperdata :: User -> DBCmd err [Node HyperdataUser]
 getUserNodeHyperdata (RootId uId) = do
   runOpaQuery (selectUserHyperdataWithId uId)
   where
@@ -215,14 +215,14 @@ getUserNodeHyperdata (UserDBId uId) = do
       returnA  -< row
 getUserNodeHyperdata _ = undefined
 
-getUsersWithHyperdata :: User -> Cmd err [(UserLight, HyperdataUser)]
+getUsersWithHyperdata :: User -> DBCmd err [(UserLight, HyperdataUser)]
 getUsersWithHyperdata i = do
   u <- getUsersWithId i
   h <- getUserHyperdata i
   -- printDebug "[getUsersWithHyperdata]" (u,h)
   pure $ zip u h
 
-getUsersWithNodeHyperdata :: User -> Cmd err [(UserLight, Node HyperdataUser)]
+getUsersWithNodeHyperdata :: User -> DBCmd err [(UserLight, Node HyperdataUser)]
 getUsersWithNodeHyperdata i = do
   u <- getUsersWithId i
   h <- getUserNodeHyperdata i
@@ -230,7 +230,7 @@ getUsersWithNodeHyperdata i = do
   pure $ zip u h
 
 
-updateUserEmail :: UserLight -> Cmd err Int64
+updateUserEmail :: UserLight -> DBCmd err Int64
 updateUserEmail (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
   where
     updateUserQuery :: Update Int64
@@ -240,7 +240,7 @@ updateUserEmail (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
       , uWhere      = (\row -> user_id row .== (sqlInt4 userLight_id))
       , uReturning  = rCount }
 
-updateUserPassword :: UserLight -> Cmd err Int64
+updateUserPassword :: UserLight -> DBCmd err Int64
 updateUserPassword (UserLight { userLight_password = GargPassword password, .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
   where
     updateUserQuery :: Update Int64
@@ -250,7 +250,7 @@ updateUserPassword (UserLight { userLight_password = GargPassword password, .. }
       , uWhere      = \row -> user_id row .== sqlInt4 userLight_id
       , uReturning  = rCount }
 
-updateUserForgotPasswordUUID :: UserLight -> Cmd err Int64
+updateUserForgotPasswordUUID :: UserLight -> DBCmd err Int64
 updateUserForgotPasswordUUID (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c updateUserQuery
   where
     pass = sqlStrictText $ fromMaybe "" userLight_forgot_password_uuid
@@ -261,7 +261,7 @@ updateUserForgotPasswordUUID (UserLight { .. }) = mkCmd $ \c -> runUpdate_ c upd
       , uWhere      = \row -> user_id row .== sqlInt4 userLight_id
       , uReturning  = rCount }
 
-getUserPubmedAPIKey :: User -> Cmd err (Maybe PUBMED.APIKey)
+getUserPubmedAPIKey :: User -> DBCmd err (Maybe PUBMED.APIKey)
 getUserPubmedAPIKey user = do
   hs <- getUserHyperdata user
   case hs of
@@ -269,7 +269,7 @@ getUserPubmedAPIKey user = do
     (x:_) -> pure $ _hu_pubmed_api_key x
 
 updateUserPubmedAPIKey :: (HasDBid NodeType, HasNodeError err)
-                        => User -> PUBMED.APIKey -> Cmd err Int64
+                        => User -> PUBMED.APIKey -> DBCmd err Int64
 updateUserPubmedAPIKey (RootId uId) apiKey = do
   _ <- updateNodeWithType uId NodeUser (Proxy :: Proxy HyperdataUser) (\h -> h & hu_pubmed_api_key ?~ apiKey)
   pure 1
@@ -303,7 +303,7 @@ getUser :: Username -> DBCmd err (Maybe UserLight)
 getUser u = userLightWithUsername u <$> usersLight
 
 ----------------------------------------------------------------------
-insertNewUsers :: [NewUser GargPassword] -> Cmd err Int64
+insertNewUsers :: [NewUser GargPassword] -> DBCmd err Int64
 insertNewUsers newUsers = do
   users' <- liftBase $ mapM toUserHash newUsers
   insertUsers $ map toUserWrite users'