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
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
Julien Moutinho
haskell-gargantext
Commits
a1356260
Commit
a1356260
authored
May 19, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[SECURITY] newtype GargPassword with Show hidden.
parent
eed33b26
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
30 additions
and
11 deletions
+30
-11
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+6
-4
Individu.hs
src/Gargantext/Core/Types/Individu.hs
+24
-7
No files found.
src/Gargantext/API/Admin/Auth.hs
View file @
a1356260
...
...
@@ -41,7 +41,7 @@ import Data.Text.Lazy.Encoding (decodeUtf8)
import
GHC.Generics
(
Generic
)
import
Gargantext.API.Admin.Settings
import
Gargantext.API.Prelude
(
HasJoseError
(
..
),
joseError
,
HasServerError
,
GargServerC
)
import
Gargantext.Core.Types.Individu
(
User
(
..
),
Username
,
Password
,
arbitraryUsername
,
arbitraryPassword
)
import
Gargantext.Core.Types.Individu
(
User
(
..
),
Username
,
GargPassword
(
..
)
,
arbitraryUsername
,
arbitraryPassword
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Database.Query.Tree
(
isDescendantOf
,
isIn
)
import
Gargantext.Database.Query.Tree.Root
(
getRoot
)
...
...
@@ -60,7 +60,7 @@ import qualified Gargantext.Core.Auth as Auth
-- | Main types for AUTH API
data
AuthRequest
=
AuthRequest
{
_authReq_username
::
Username
,
_authReq_password
::
Password
,
_authReq_password
::
Garg
Password
}
deriving
(
Generic
)
...
...
@@ -98,9 +98,9 @@ makeTokenForUser uid = do
checkAuthRequest
::
(
HasSettings
env
,
HasConnectionPool
env
,
HasJoseError
err
)
=>
Username
->
Password
->
Garg
Password
->
Cmd'
env
err
CheckAuth
checkAuthRequest
u
p
=
do
checkAuthRequest
u
(
GargPassword
p
)
=
do
candidate
<-
head
<$>
getUsersWith
u
case
candidate
of
Nothing
->
pure
InvalidUser
...
...
@@ -129,8 +129,10 @@ newtype AuthenticatedUser = AuthenticatedUser
}
deriving
(
Generic
)
$
(
deriveJSON
(
unPrefix
"_authUser_"
)
''
A
uthenticatedUser
)
instance
ToSchema
AuthenticatedUser
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"_authUser_"
)
instance
ToJWT
AuthenticatedUser
instance
FromJWT
AuthenticatedUser
...
...
src/Gargantext/Core/Types/Individu.hs
View file @
a1356260
...
...
@@ -11,16 +11,22 @@ Individu defintions
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module
Gargantext.Core.Types.Individu
where
import
Data.Aeson.TH
(
deriveJSON
)
import
Control.Monad.IO.Class
(
MonadIO
)
import
GHC.Generics
(
Generic
)
import
Data.Swagger
import
Data.Text
(
Text
,
pack
,
reverse
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
,
UserId
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
)
import
Gargantext.Prelude
hiding
(
reverse
)
import
qualified
Gargantext.Core.Auth
as
Auth
...
...
@@ -29,7 +35,15 @@ data User = UserDBId UserId | UserName Text | RootId NodeId
deriving
(
Eq
)
type
Username
=
Text
type
Password
=
Text
newtype
GargPassword
=
GargPassword
Text
deriving
(
Generic
)
instance
Show
GargPassword
where
show
(
GargPassword
_
)
=
"*GargPassword*"
instance
ToSchema
GargPassword
type
Email
=
Text
type
UsernameMaster
=
Username
...
...
@@ -42,8 +56,8 @@ arbitraryUsername = ["gargantua"] <> users
users
=
zipWith
(
\
a
b
->
a
<>
(
pack
.
show
)
b
)
(
repeat
"user"
)
([
1
..
20
]
::
[
Int
])
arbitraryPassword
::
[
Password
]
arbitraryPassword
=
map
reverse
arbitraryUsername
arbitraryPassword
::
[
Garg
Password
]
arbitraryPassword
=
map
(
\
u
->
GargPassword
(
reverse
u
))
arbitraryUsername
-----------------------------------------------------------
...
...
@@ -52,12 +66,15 @@ arbitraryUsersHash :: MonadIO m
arbitraryUsersHash
=
mapM
userHash
arbitraryUsers
userHash
::
MonadIO
m
=>
(
Username
,
Email
,
Password
)
=>
(
Username
,
Email
,
Garg
Password
)
->
m
(
Username
,
Email
,
Auth
.
PasswordHash
Auth
.
Argon2
)
userHash
(
u
,
m
,
p
)
=
do
userHash
(
u
,
m
,
GargPassword
p
)
=
do
h
<-
Auth
.
createPasswordHash
p
pure
(
u
,
m
,
h
)
arbitraryUsers
::
[(
Username
,
Email
,
Password
)]
arbitraryUsers
=
map
(
\
u
->
(
u
,
u
<>
"@gargantext.org"
,
reverse
u
))
arbitraryUsername
arbitraryUsers
::
[(
Username
,
Email
,
GargPassword
)]
arbitraryUsers
=
map
(
\
u
->
(
u
,
u
<>
"@gargantext.org"
,
GargPassword
$
reverse
u
))
arbitraryUsername
$
(
deriveJSON
(
unPrefix
""
)
''
G
argPassword
)
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