Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
H
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Przemyslaw Kaminski
haskell-gargantext
Commits
fb027ced
Commit
fb027ced
authored
Sep 14, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[FEAT] mkNewUser created
parent
b7e19458
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
48 additions
and
8 deletions
+48
-8
Individu.hs
src/Gargantext/Core/Types/Individu.hs
+3
-3
User.hs
src/Gargantext/Database/Action/User.hs
+37
-0
User.hs
src/Gargantext/Database/Query/Table/User.hs
+8
-5
No files found.
src/Gargantext/Core/Types/Individu.hs
View file @
fb027ced
...
...
@@ -60,16 +60,16 @@ arbitraryPassword :: [GargPassword]
arbitraryPassword
=
map
(
\
u
->
GargPassword
(
reverse
u
))
arbitraryUsername
-----------------------------------------------------------
u
serHash
::
MonadIO
m
toU
serHash
::
MonadIO
m
=>
NewUser
GargPassword
->
m
(
NewUser
HashPassword
)
u
serHash
(
NewUser
u
m
(
GargPassword
p
))
=
do
toU
serHash
(
NewUser
u
m
(
GargPassword
p
))
=
do
h
<-
Auth
.
createPasswordHash
p
pure
$
NewUser
u
m
h
arbitraryUsersHash
::
MonadIO
m
=>
m
[
NewUser
HashPassword
]
arbitraryUsersHash
=
mapM
u
serHash
arbitraryUsers
arbitraryUsersHash
=
mapM
toU
serHash
arbitraryUsers
arbitraryUsers
::
[
NewUser
GargPassword
]
arbitraryUsers
=
map
(
\
u
->
NewUser
u
(
u
<>
"@gargantext.org"
)
(
GargPassword
$
reverse
u
))
...
...
src/Gargantext/Database/Action/User.hs
0 → 100644
View file @
fb027ced
{-|
Module : Gargantext.Database.Action.User
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module
Gargantext.Database.Action.User
where
import
Gargantext.Database.Query.Table.User
import
Gargantext.Core.Types.Individu
import
Gargantext.Database.Prelude
import
Gargantext.Prelude
import
Gargantext.Database.Query.Table.Node.Error
(
HasNodeError
(
..
))
import
Gargantext.Database.Action.Flow
(
getOrMkRoot
)
mkUser
::
HasNodeError
err
=>
NewUser
GargPassword
->
Cmd
err
Int64
mkUser
u
=
mkUsers
[
u
]
mkUsers
::
HasNodeError
err
=>
[
NewUser
GargPassword
]
->
Cmd
err
Int64
mkUsers
us
=
do
us'
<-
liftBase
$
mapM
toUserHash
us
r
<-
insertUsers
$
map
toUserWrite
us'
_
<-
mapM
getOrMkRoot
$
map
(
\
u
->
UserName
(
_nu_username
u
))
us
pure
r
-- | TODO
rmUser
::
HasNodeError
err
=>
User
->
Cmd
err
Int64
rmUser
=
undefined
src/Gargantext/Database/Query/Table/User.hs
View file @
fb027ced
...
...
@@ -19,6 +19,7 @@ Functions to deal with users, database side.
module
Gargantext.Database.Query.Table.User
(
insertUsers
,
toUserWrite
,
queryUserTable
,
getUser
,
insertUsersDemo
...
...
@@ -51,11 +52,6 @@ insertUsers us = mkCmd $ \c -> runInsert_ c insert
where
insert
=
Insert
userTable
us
rCount
Nothing
insertUsersDemo
::
Cmd
err
Int64
insertUsersDemo
=
do
users
<-
liftBase
arbitraryUsersHash
insertUsers
$
map
toUserWrite
users
-----------------------------------------------------------------------
toUserWrite
::
NewUser
HashPassword
->
UserWrite
toUserWrite
(
NewUser
u
m
(
Auth
.
PasswordHash
p
))
=
...
...
@@ -109,6 +105,13 @@ usersLight = map toUserLight <$> users
getUser
::
Username
->
Cmd
err
(
Maybe
UserLight
)
getUser
u
=
userLightWithUsername
u
<$>
usersLight
----------------------------------------------------------------------
insertUsersDemo
::
Cmd
err
Int64
insertUsersDemo
=
do
users
<-
liftBase
arbitraryUsersHash
insertUsers
$
map
toUserWrite
users
----------------------------------------------------------------------
instance
QueryRunnerColumnDefault
PGTimestamptz
(
Maybe
UTCTime
)
where
queryRunnerColumnDefault
=
fieldQueryRunnerColumn
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