Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
144
Issues
144
List
Board
Labels
Milestones
Merge Requests
9
Merge Requests
9
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
ff00345c
Commit
ff00345c
authored
Nov 26, 2024
by
Grégoire Locqueville
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Renamed CmdM' into CmdBasic
parent
e922a044
Pipeline
#7044
canceled with stages
in 5 minutes and 25 seconds
Changes
7
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
28 additions
and
28 deletions
+28
-28
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+7
-7
Dev.hs
src/Gargantext/API/Dev.hs
+3
-3
Utils.hs
src/Gargantext/API/GraphQL/Utils.hs
+2
-2
Types.hs
src/Gargantext/API/Ngrams/Types.hs
+2
-2
Jobs.hs
src/Gargantext/Core/Worker/Jobs.hs
+2
-2
Delete.hs
src/Gargantext/Database/Action/Delete.hs
+2
-2
Prelude.hs
src/Gargantext/Database/Prelude.hs
+10
-10
No files found.
src/Gargantext/API/Admin/Auth.hs
View file @
ff00345c
...
...
@@ -61,7 +61,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
(
SomeCmdBasic
,
CmdCommon
,
DbCmd
'
)
import
Gargantext.Database.Query.Table.User
import
Gargantext.Database.Query.Tree
(
isDescendantOf
,
isIn
)
import
Gargantext.Database.Query.Tree.Root
(
getRoot
)
...
...
@@ -82,7 +82,7 @@ import qualified Gargantext.API.Routes.Named as Named
makeTokenForUser
::
(
HasJWTSettings
env
,
HasAuthenticationError
err
)
=>
NodeId
->
UserId
->
Cmd'
env
err
Token
->
SomeCmdBasic
env
err
Token
makeTokenForUser
nodeId
userId
=
do
jwtS
<-
view
jwtSettings
e
<-
liftBase
$
makeJWT
(
AuthenticatedUser
nodeId
userId
)
jwtS
Nothing
...
...
@@ -237,12 +237,12 @@ forgotPassword = Named.ForgotPasswordAPI
}
forgotPasswordPost
::
(
CmdCommon
env
)
=>
ForgotPasswordRequest
->
Cmd'
env
err
ForgotPasswordResponse
=>
ForgotPasswordRequest
->
SomeCmdBasic
env
err
ForgotPasswordResponse
forgotPasswordPost
(
ForgotPasswordRequest
_email
)
=
do
pure
$
ForgotPasswordResponse
"ok"
forgotPasswordGet
::
(
CmdCommon
env
,
HasServerError
err
)
=>
Maybe
Text
->
Cmd'
env
err
ForgotPasswordGet
=>
Maybe
Text
->
SomeCmdBasic
env
err
ForgotPasswordGet
forgotPasswordGet
Nothing
=
pure
$
ForgotPasswordGet
""
forgotPasswordGet
(
Just
uuid
)
=
do
let
mUuid
=
fromText
uuid
...
...
@@ -259,7 +259,7 @@ forgotPasswordGet (Just uuid) = do
---------------------
forgotPasswordGetUser
::
(
CmdCommon
env
)
=>
UserLight
->
Cmd'
env
err
ForgotPasswordGet
=>
UserLight
->
SomeCmdBasic
env
err
ForgotPasswordGet
forgotPasswordGetUser
(
UserLight
{
..
})
=
do
-- pick some random password
password
<-
liftBase
gargPass
...
...
@@ -278,7 +278,7 @@ forgotPasswordGetUser (UserLight { .. }) = do
pure
$
ForgotPasswordGet
password
forgotUserPassword
::
(
CmdCommon
env
)
=>
UserLight
->
Cmd'
env
err
()
=>
UserLight
->
SomeCmdBasic
env
err
()
forgotUserPassword
(
UserLight
{
..
})
=
do
--printDebug "[forgotUserPassword] userLight_id" userLight_id
--logDebug $ "[forgotUserPassword]" :# ["userLight_id" .= userLight_id]
...
...
@@ -303,7 +303,7 @@ forgotUserPassword (UserLight { .. }) = do
-- Generate a unique (in whole DB) UUID for passwords.
generateForgotPasswordUUID
::
(
CmdCommon
env
)
=>
Cmd'
env
err
UUID
=>
SomeCmdBasic
env
err
UUID
generateForgotPasswordUUID
=
do
uuid
<-
liftBase
$
nextRandom
us
<-
getUsersWithForgotPasswordUUID
uuid
...
...
src/Gargantext/API/Dev.hs
View file @
ff00345c
...
...
@@ -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
(
SomeCmdBasic
,
Cmd
''
,
connPool
,
runCmd
)
import
Gargantext.Prelude
import
Gargantext.Core.Config.Utils
(
readConfig
)
import
Gargantext.System.Logging
(
withLoggerHoisted
)
...
...
@@ -70,10 +70,10 @@ 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
->
SomeCmdBasic
DevEnv
()
a
->
IO
a
runCmdDevNoErr
=
runCmdDev
runCmdDevServantErr
::
DevEnv
->
Cmd'
DevEnv
ServerError
a
->
IO
a
runCmdDevServantErr
::
DevEnv
->
SomeCmdBasic
DevEnv
ServerError
a
->
IO
a
runCmdDevServantErr
=
runCmdDev
runCmdReplEasy
::
Cmd''
DevEnv
BackendInternalError
a
->
IO
a
...
...
src/Gargantext/API/GraphQL/Utils.hs
View file @
ff00345c
...
...
@@ -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
(
SomeCmdBasic
)
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
->
SomeCmdBasic
env
err
AuthStatus
authUser
ui_id
token
=
do
let
token'
=
encodeUtf8
token
jwtS
<-
view
jwtSettings
...
...
src/Gargantext/API/Ngrams/Types.hs
View file @
ff00345c
...
...
@@ -45,7 +45,7 @@ import Gargantext.Core.Types (ListType(..), ListId, NodeId, TODO)
import
Gargantext.Core.Types.Query
(
Limit
,
Offset
,
MaxSize
,
MinSize
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixUntagged
,
unPrefixSwagger
,
wellNamedSchema
)
import
Gargantext.Database.Admin.Types.Node
(
ContextId
)
import
Gargantext.Database.Prelude
(
fromField'
,
HasConnectionPool
,
Cmd
M
'
)
import
Gargantext.Database.Prelude
(
fromField'
,
HasConnectionPool
,
Cmd
Basic
)
import
Gargantext.Prelude
hiding
(
IsString
,
hash
,
from
,
replace
,
to
)
import
Gargantext.Prelude.Crypto.Hash
(
IsHashable
(
..
))
import
Gargantext.Utils.Servant
(
TSV
,
ZIP
)
...
...
@@ -729,7 +729,7 @@ initRepo = Repo 1 mempty []
--------------------
type
RepoCmdM
env
err
m
=
(
Cmd
M'
env
err
m
(
Cmd
Basic
env
err
m
,
HasConnectionPool
env
,
HasConfig
env
)
...
...
src/Gargantext/Core/Worker/Jobs.hs
View file @
ff00345c
...
...
@@ -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
(
SomeCmdBasic
)
import
Gargantext.Prelude
import
Gargantext.System.Logging
(
logMsg
,
withLogger
,
LogLevel
(
..
))
sendJob
::
(
HasWorkerBroker
,
HasConfig
env
)
=>
Job
->
Cmd'
env
err
MessageId
->
SomeCmdBasic
env
err
MessageId
sendJob
job
=
do
gcConfig
<-
view
$
hasConfig
liftBase
$
sendJobWithCfg
gcConfig
job
...
...
src/Gargantext/Database/Action/Delete.hs
View file @
ff00345c
...
...
@@ -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
(
SomeCmdBasic
,
CmdCommon
)
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
)
...
...
@@ -41,7 +41,7 @@ import Gargantext.Prelude
deleteNode
::
(
CmdCommon
env
,
HasNodeError
err
)
=>
User
->
NodeId
->
Cmd'
env
err
Int
->
SomeCmdBasic
env
err
Int
deleteNode
u
nodeId
=
do
node'
<-
N
.
getNode
nodeId
num
<-
case
(
view
node_typename
node'
)
of
...
...
src/Gargantext/Database/Prelude.hs
View file @
ff00345c
...
...
@@ -59,7 +59,7 @@ type CmdM'' env err m =
,
MonadRandom
m
)
type
Cmd
M'
env
err
m
=
type
Cmd
Basic
env
err
m
=
(
MonadReader
env
m
,
MonadError
err
m
,
MonadBaseControl
IO
m
...
...
@@ -82,19 +82,19 @@ type CmdCommon env =
,
CET
.
HasCentralExchangeNotification
env
)
type
CmdM
env
err
m
=
(
Cmd
M'
env
err
m
(
Cmd
Basic
env
err
m
,
CmdCommon
env
)
type
CmdRandom
env
err
m
=
(
Cmd
M'
env
err
m
(
Cmd
Basic
env
err
m
,
DbCommon
env
,
MonadRandom
m
,
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
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
...
...
@@ -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,
-- that these constraints stays as few as possible.
type
DbCmd'
env
err
m
=
(
Cmd
M'
env
err
m
Cmd
Basic
env
err
m
,
DbCommon
env
)
...
...
Grégoire Locqueville
@glocqueville
mentioned in commit
f785e149
·
Nov 26, 2024
mentioned in commit
f785e149
mentioned in commit f785e14983a173d273518004432f122d30c9df3b
Toggle commit list
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment