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

Renamed CmdM' into CmdBasic

parent e922a044
Pipeline #7044 canceled with stages
in 5 minutes and 25 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 (Cmd', CmdCommon, DbCmd') import Gargantext.Database.Prelude (SomeCmdBasic, 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
-> Cmd' env err Token -> SomeCmdBasic 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 -> Cmd' env err ForgotPasswordResponse => ForgotPasswordRequest -> SomeCmdBasic 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 -> Cmd' env err ForgotPasswordGet => Maybe Text -> SomeCmdBasic 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 -> Cmd' env err ForgotPasswordGet => UserLight -> SomeCmdBasic 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 -> Cmd' env err () => UserLight -> SomeCmdBasic 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)
=> Cmd' env err UUID => SomeCmdBasic 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 (Cmd', Cmd'', connPool, runCmd) import Gargantext.Database.Prelude (SomeCmdBasic, 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 -> Cmd' DevEnv () a -> IO a runCmdDevNoErr :: DevEnv -> SomeCmdBasic DevEnv () a -> IO a
runCmdDevNoErr = runCmdDev runCmdDevNoErr = runCmdDev
runCmdDevServantErr :: DevEnv -> Cmd' DevEnv ServerError a -> IO a runCmdDevServantErr :: DevEnv -> SomeCmdBasic 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 (Cmd') import Gargantext.Database.Prelude (SomeCmdBasic)
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 -> Cmd' env err AuthStatus authUser :: (HasJWTSettings env) => NodeId -> Text -> SomeCmdBasic 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, CmdM') import Gargantext.Database.Prelude (fromField', HasConnectionPool, CmdBasic)
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 =
( CmdM' env err m ( CmdBasic 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 (Cmd') import Gargantext.Database.Prelude (SomeCmdBasic)
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
-> Cmd' env err MessageId -> SomeCmdBasic 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 (Cmd', CmdCommon) import Gargantext.Database.Prelude (SomeCmdBasic, 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
-> Cmd' env err Int -> SomeCmdBasic 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 CmdM' env err m = type CmdBasic env err m =
( MonadReader env m ( MonadReader env m
, MonadError err m , MonadError err m
, MonadBaseControl IO m , MonadBaseControl IO m
...@@ -82,29 +82,29 @@ type CmdCommon env = ...@@ -82,29 +82,29 @@ type CmdCommon env =
, CET.HasCentralExchangeNotification env ) , CET.HasCentralExchangeNotification env )
type CmdM env err m = type CmdM env err m =
( CmdM' env err m ( CmdBasic env err m
, CmdCommon env , CmdCommon env
) )
type CmdRandom env err m = type CmdRandom env err m =
( CmdM' env err m ( CmdBasic 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 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 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
type DBCmd err a = forall m env. 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 -- | Only the /minimum/ amount of class constraints required
-- 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 = (
CmdM' env err m CmdBasic 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