Commit f785e149 authored by Grégoire Locqueville's avatar Grégoire Locqueville

Revert "Renamed CmdM' into CmdBasic"

This reverts commit ff00345c
parent ff00345c
Pipeline #7045 failed with stages
in 69 minutes and 28 seconds
...@@ -61,7 +61,7 @@ import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..)) ...@@ -61,7 +61,7 @@ import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
import Gargantext.Core.Worker.Jobs.Types qualified as Jobs import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
import Gargantext.Database.Action.User.New (guessUserName) import Gargantext.Database.Action.User.New (guessUserName)
import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId) import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId)
import Gargantext.Database.Prelude (SomeCmdBasic, CmdCommon, DbCmd') import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
import Gargantext.Database.Query.Table.User import Gargantext.Database.Query.Table.User
import Gargantext.Database.Query.Tree (isDescendantOf, isIn) import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
import Gargantext.Database.Query.Tree.Root (getRoot) import Gargantext.Database.Query.Tree.Root (getRoot)
...@@ -82,7 +82,7 @@ import qualified Gargantext.API.Routes.Named as Named ...@@ -82,7 +82,7 @@ import qualified Gargantext.API.Routes.Named as Named
makeTokenForUser :: (HasJWTSettings env, HasAuthenticationError err) makeTokenForUser :: (HasJWTSettings env, HasAuthenticationError err)
=> NodeId => NodeId
-> UserId -> UserId
-> SomeCmdBasic env err Token -> Cmd' env err Token
makeTokenForUser nodeId userId = do makeTokenForUser nodeId userId = do
jwtS <- view jwtSettings jwtS <- view jwtSettings
e <- liftBase $ makeJWT (AuthenticatedUser nodeId userId) jwtS Nothing e <- liftBase $ makeJWT (AuthenticatedUser nodeId userId) jwtS Nothing
...@@ -237,12 +237,12 @@ forgotPassword = Named.ForgotPasswordAPI ...@@ -237,12 +237,12 @@ forgotPassword = Named.ForgotPasswordAPI
} }
forgotPasswordPost :: (CmdCommon env) forgotPasswordPost :: (CmdCommon env)
=> ForgotPasswordRequest -> SomeCmdBasic env err ForgotPasswordResponse => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
forgotPasswordPost (ForgotPasswordRequest _email) = do forgotPasswordPost (ForgotPasswordRequest _email) = do
pure $ ForgotPasswordResponse "ok" pure $ ForgotPasswordResponse "ok"
forgotPasswordGet :: (CmdCommon env, HasServerError err) forgotPasswordGet :: (CmdCommon env, HasServerError err)
=> Maybe Text -> SomeCmdBasic env err ForgotPasswordGet => Maybe Text -> Cmd' env err ForgotPasswordGet
forgotPasswordGet Nothing = pure $ ForgotPasswordGet "" forgotPasswordGet Nothing = pure $ ForgotPasswordGet ""
forgotPasswordGet (Just uuid) = do forgotPasswordGet (Just uuid) = do
let mUuid = fromText uuid let mUuid = fromText uuid
...@@ -259,7 +259,7 @@ forgotPasswordGet (Just uuid) = do ...@@ -259,7 +259,7 @@ forgotPasswordGet (Just uuid) = do
--------------------- ---------------------
forgotPasswordGetUser :: ( CmdCommon env) forgotPasswordGetUser :: ( CmdCommon env)
=> UserLight -> SomeCmdBasic env err ForgotPasswordGet => UserLight -> Cmd' env err ForgotPasswordGet
forgotPasswordGetUser (UserLight { .. }) = do forgotPasswordGetUser (UserLight { .. }) = do
-- pick some random password -- pick some random password
password <- liftBase gargPass password <- liftBase gargPass
...@@ -278,7 +278,7 @@ forgotPasswordGetUser (UserLight { .. }) = do ...@@ -278,7 +278,7 @@ forgotPasswordGetUser (UserLight { .. }) = do
pure $ ForgotPasswordGet password pure $ ForgotPasswordGet password
forgotUserPassword :: (CmdCommon env) forgotUserPassword :: (CmdCommon env)
=> UserLight -> SomeCmdBasic env err () => UserLight -> Cmd' env err ()
forgotUserPassword (UserLight { .. }) = do forgotUserPassword (UserLight { .. }) = do
--printDebug "[forgotUserPassword] userLight_id" userLight_id --printDebug "[forgotUserPassword] userLight_id" userLight_id
--logDebug $ "[forgotUserPassword]" :# ["userLight_id" .= userLight_id] --logDebug $ "[forgotUserPassword]" :# ["userLight_id" .= userLight_id]
...@@ -303,7 +303,7 @@ forgotUserPassword (UserLight { .. }) = do ...@@ -303,7 +303,7 @@ forgotUserPassword (UserLight { .. }) = do
-- Generate a unique (in whole DB) UUID for passwords. -- Generate a unique (in whole DB) UUID for passwords.
generateForgotPasswordUUID :: (CmdCommon env) generateForgotPasswordUUID :: (CmdCommon env)
=> SomeCmdBasic env err UUID => Cmd' env err UUID
generateForgotPasswordUUID = do generateForgotPasswordUUID = do
uuid <- liftBase $ nextRandom uuid <- liftBase $ nextRandom
us <- getUsersWithForgotPasswordUUID uuid us <- getUsersWithForgotPasswordUUID uuid
......
...@@ -23,7 +23,7 @@ import Gargantext.API.Prelude ( GargM ) ...@@ -23,7 +23,7 @@ import Gargantext.API.Prelude ( GargM )
import Gargantext.Core.Config (_gc_database_config) import Gargantext.Core.Config (_gc_database_config)
import Gargantext.Core.Config.Types (SettingsFile(..)) import Gargantext.Core.Config.Types (SettingsFile(..))
import Gargantext.Core.NodeStory (fromDBNodeStoryEnv) import Gargantext.Core.NodeStory (fromDBNodeStoryEnv)
import Gargantext.Database.Prelude (SomeCmdBasic, Cmd'', connPool, runCmd) import Gargantext.Database.Prelude (Cmd', Cmd'', connPool, runCmd)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Core.Config.Utils (readConfig) import Gargantext.Core.Config.Utils (readConfig)
import Gargantext.System.Logging ( withLoggerHoisted ) import Gargantext.System.Logging ( withLoggerHoisted )
...@@ -70,10 +70,10 @@ runCmdGargDev :: DevEnv -> GargM DevEnv BackendInternalError a -> IO a ...@@ -70,10 +70,10 @@ runCmdGargDev :: DevEnv -> GargM DevEnv BackendInternalError a -> IO a
runCmdGargDev env cmd = runCmdGargDev env cmd =
either (fail . show) pure =<< runExceptT (runReaderT cmd env) either (fail . show) pure =<< runExceptT (runReaderT cmd env)
runCmdDevNoErr :: DevEnv -> SomeCmdBasic DevEnv () a -> IO a runCmdDevNoErr :: DevEnv -> Cmd' DevEnv () a -> IO a
runCmdDevNoErr = runCmdDev runCmdDevNoErr = runCmdDev
runCmdDevServantErr :: DevEnv -> SomeCmdBasic DevEnv ServerError a -> IO a runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a
runCmdDevServantErr = runCmdDev runCmdDevServantErr = runCmdDev
runCmdReplEasy :: Cmd'' DevEnv BackendInternalError a -> IO a runCmdReplEasy :: Cmd'' DevEnv BackendInternalError a -> IO a
......
...@@ -16,13 +16,13 @@ import Control.Lens (view) ...@@ -16,13 +16,13 @@ import Control.Lens (view)
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (..), auth_node_id) import Gargantext.API.Admin.Auth.Types (AuthenticatedUser (..), auth_node_id)
import Gargantext.Core.Config (HasJWTSettings(..)) import Gargantext.Core.Config (HasJWTSettings(..))
import Gargantext.Database.Admin.Types.Node (NodeId) import Gargantext.Database.Admin.Types.Node (NodeId)
import Gargantext.Database.Prelude (SomeCmdBasic) import Gargantext.Database.Prelude (Cmd')
import Gargantext.Prelude import Gargantext.Prelude
import Servant.Auth.Server (verifyJWT, JWTSettings) import Servant.Auth.Server (verifyJWT, JWTSettings)
data AuthStatus = Valid | Invalid data AuthStatus = Valid | Invalid
authUser :: (HasJWTSettings env) => NodeId -> Text -> SomeCmdBasic env err AuthStatus authUser :: (HasJWTSettings env) => NodeId -> Text -> Cmd' env err AuthStatus
authUser ui_id token = do authUser ui_id token = do
let token' = encodeUtf8 token let token' = encodeUtf8 token
jwtS <- view jwtSettings jwtS <- view jwtSettings
......
...@@ -45,7 +45,7 @@ import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO) ...@@ -45,7 +45,7 @@ import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO)
import Gargantext.Core.Types.Query (Limit, Offset, MaxSize, MinSize) import Gargantext.Core.Types.Query (Limit, Offset, MaxSize, MinSize)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema) import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixUntagged, unPrefixSwagger, wellNamedSchema)
import Gargantext.Database.Admin.Types.Node (ContextId) import Gargantext.Database.Admin.Types.Node (ContextId)
import Gargantext.Database.Prelude (fromField', HasConnectionPool, CmdBasic) import Gargantext.Database.Prelude (fromField', HasConnectionPool, CmdM')
import Gargantext.Prelude hiding (IsString, hash, from, replace, to) import Gargantext.Prelude hiding (IsString, hash, from, replace, to)
import Gargantext.Prelude.Crypto.Hash (IsHashable(..)) import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
import Gargantext.Utils.Servant (TSV, ZIP) import Gargantext.Utils.Servant (TSV, ZIP)
...@@ -729,7 +729,7 @@ initRepo = Repo 1 mempty [] ...@@ -729,7 +729,7 @@ initRepo = Repo 1 mempty []
-------------------- --------------------
type RepoCmdM env err m = type RepoCmdM env err m =
( CmdBasic env err m ( CmdM' env err m
, HasConnectionPool env , HasConnectionPool env
, HasConfig env , HasConfig env
) )
......
...@@ -20,14 +20,14 @@ import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..)) ...@@ -20,14 +20,14 @@ import Gargantext.Core.Config.Worker (WorkerSettings(..), WorkerDefinition(..))
import Gargantext.Core.Worker.Broker (initBrokerWithDBCreate) import Gargantext.Core.Worker.Broker (initBrokerWithDBCreate)
import Gargantext.Core.Worker.Jobs.Types (Job(..)) import Gargantext.Core.Worker.Jobs.Types (Job(..))
import Gargantext.Core.Worker.PGMQTypes (HasWorkerBroker, MessageId, SendJob) import Gargantext.Core.Worker.PGMQTypes (HasWorkerBroker, MessageId, SendJob)
import Gargantext.Database.Prelude (SomeCmdBasic) import Gargantext.Database.Prelude (Cmd')
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.System.Logging (logMsg, withLogger, LogLevel(..)) import Gargantext.System.Logging (logMsg, withLogger, LogLevel(..))
sendJob :: (HasWorkerBroker, HasConfig env) sendJob :: (HasWorkerBroker, HasConfig env)
=> Job => Job
-> SomeCmdBasic env err MessageId -> Cmd' env err MessageId
sendJob job = do sendJob job = do
gcConfig <- view $ hasConfig gcConfig <- view $ hasConfig
liftBase $ sendJobWithCfg gcConfig job liftBase $ sendJobWithCfg gcConfig job
......
...@@ -27,7 +27,7 @@ import Gargantext.Database.Action.User (getUserId) ...@@ -27,7 +27,7 @@ import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) ) import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) )
import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(..) ) -- (NodeType(..)) import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType(..) ) -- (NodeType(..))
import Gargantext.Database.GargDB qualified as GargDB import Gargantext.Database.GargDB qualified as GargDB
import Gargantext.Database.Prelude (SomeCmdBasic, CmdCommon) import Gargantext.Database.Prelude (Cmd', CmdCommon)
import Gargantext.Database.Query.Table.Node (getNodeWith) import Gargantext.Database.Query.Table.Node (getNodeWith)
import Gargantext.Database.Query.Table.Node qualified as N (getNode, deleteNode) import Gargantext.Database.Query.Table.Node qualified as N (getNode, deleteNode)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
...@@ -41,7 +41,7 @@ import Gargantext.Prelude ...@@ -41,7 +41,7 @@ import Gargantext.Prelude
deleteNode :: (CmdCommon env, HasNodeError err) deleteNode :: (CmdCommon env, HasNodeError err)
=> User => User
-> NodeId -> NodeId
-> SomeCmdBasic env err Int -> Cmd' env err Int
deleteNode u nodeId = do deleteNode u nodeId = do
node' <- N.getNode nodeId node' <- N.getNode nodeId
num <- case (view node_typename node') of num <- case (view node_typename node') of
......
...@@ -59,7 +59,7 @@ type CmdM'' env err m = ...@@ -59,7 +59,7 @@ type CmdM'' env err m =
, MonadRandom m , MonadRandom m
) )
type CmdBasic env err m = type CmdM' env err m =
( MonadReader env m ( MonadReader env m
, MonadError err m , MonadError err m
, MonadBaseControl IO m , MonadBaseControl IO m
...@@ -82,19 +82,19 @@ type CmdCommon env = ...@@ -82,19 +82,19 @@ type CmdCommon env =
, CET.HasCentralExchangeNotification env ) , CET.HasCentralExchangeNotification env )
type CmdM env err m = type CmdM env err m =
( CmdBasic env err m ( CmdM' env err m
, CmdCommon env , CmdCommon env
) )
type CmdRandom env err m = type CmdRandom env err m =
( CmdBasic env err m ( CmdM' env err m
, DbCommon env , DbCommon env
, MonadRandom m , MonadRandom m
, HasMail env , HasMail env
) )
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 SomeCmdBasic env err a = forall m. CmdBasic 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 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 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' env err a = forall m. DbCmd' env err m => m a
...@@ -104,7 +104,7 @@ type DBCmd err a = forall m env. DbCmd' env err m => m a ...@@ -104,7 +104,7 @@ type DBCmd err a = forall m env. DbCmd' env err m => m a
-- to use the Gargantext Database. It's important, to ease testability, -- to use the Gargantext Database. It's important, to ease testability,
-- that these constraints stays as few as possible. -- that these constraints stays as few as possible.
type DbCmd' env err m = ( type DbCmd' env err m = (
CmdBasic env err m CmdM' env err m
, DbCommon env , DbCommon env
) )
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment