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
157
Issues
157
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
1bf17317
Commit
1bf17317
authored
Feb 21, 2020
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[API] try to add GET user endpoint
parent
f417bede
Pipeline
#748
failed with stage
Changes
5
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
48 additions
and
14 deletions
+48
-14
API.hs
src/Gargantext/API.hs
+7
-0
Auth.hs
src/Gargantext/API/Auth.hs
+4
-1
Node.hs
src/Gargantext/API/Node.hs
+13
-0
Node.hs
src/Gargantext/Database/Schema/Node.hs
+0
-1
User.hs
src/Gargantext/Database/Schema/User.hs
+24
-12
No files found.
src/Gargantext/API.hs
View file @
1bf17317
...
...
@@ -93,6 +93,7 @@ import Gargantext.API.Types
import
qualified
Gargantext.API.Annuaire
as
Annuaire
import
qualified
Gargantext.API.Export
as
Export
import
qualified
Gargantext.API.Corpus.New
as
New
import
Gargantext.Database.Schema.User
(
UserLight
)
import
Gargantext.Database.Types.Node
import
Gargantext.Database.Types.Node
(
NodeId
,
CorpusId
,
AnnuaireId
)
import
Gargantext.Database.Utils
(
HasConnection
)
...
...
@@ -263,6 +264,11 @@ type GargPrivateAPI' =
:<|>
"corpus"
:>
Capture
"node_id"
CorpusId
:>
Export
.
API
-- Contact endpoint
:<|>
"user"
:>
Summary
"User endpoint"
:>
Capture
"user_id"
NodeId
:>
UserAPI
-- Annuaire endpoint
:<|>
"annuaire"
:>
Summary
"Annuaire endpoint"
:>
Capture
"annuaire_id"
AnnuaireId
...
...
@@ -368,6 +374,7 @@ serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataCorpus
)
uid
:<|>
nodeNodeAPI
(
Proxy
::
Proxy
HyperdataAny
)
uid
:<|>
Export
.
getCorpus
-- uid
:<|>
userAPI
(
Proxy
::
Proxy
(
Maybe
UserLight
))
uid
:<|>
nodeAPI
(
Proxy
::
Proxy
HyperdataAnnuaire
)
uid
:<|>
nodeNodeAPI
(
Proxy
::
Proxy
HyperdataContact
)
uid
...
...
src/Gargantext/API/Auth.hs
View file @
1bf17317
...
...
@@ -179,7 +179,7 @@ instance Arbitrary AuthValid where
,
tr
<-
[
1
..
3
]
]
data
PathId
=
PathNode
NodeId
|
PathNodeNode
ListId
DocId
data
PathId
=
PathNode
NodeId
|
PathNodeNode
ListId
DocId
|
PathUser
UserId
withAccessM
::
(
CmdM
env
err
m
,
HasServerError
err
)
=>
UserId
...
...
@@ -197,6 +197,9 @@ withAccessM uId (PathNodeNode cId docId) m = do
then
m
else
m
withAccessM
uId
(
PathUser
id
)
m
=
do
if
uId
==
id
then
m
else
m
-- serverError err401
withAccess
::
forall
env
err
m
api
.
(
GargServerC
env
err
m
,
HasServer
api
'[
]
)
=>
Proxy
api
->
Proxy
m
->
...
...
src/Gargantext/API/Node.hs
View file @
1bf17317
...
...
@@ -61,6 +61,7 @@ import Gargantext.Database.Facet (FacetDoc, OrderBy(..))
import
Gargantext.Database.Node.Children
(
getChildren
)
import
Gargantext.Database.Schema.Node
(
getNodesWithParentId
,
getNodeWith
,
getNode
,
deleteNode
,
deleteNodes
,
mkNodeWithParent
,
JSONB
,
HasNodeError
(
..
))
import
Gargantext.Database.Schema.NodeNode
-- (nodeNodesCategory, insertNodeNode, NodeNode(..))
import
Gargantext.Database.Schema.User
(
getUserById
,
UserLight
)
import
Gargantext.Database.Node.UpdateOpaleye
(
updateHyperdata
)
import
Gargantext.Database.Tree
(
treeDB
)
import
Gargantext.Database.Types.Node
...
...
@@ -162,6 +163,18 @@ type ChildrenApi a = Summary " Summary children"
-- :> Get '[JSON] [Node a]
:>
Get
'[
J
SON
]
(
NodeTableResult
a
)
------------------------------------------------------------------------
type
UserAPI
=
Get
'[
J
SON
]
(
Maybe
UserLight
)
userAPI
::
forall
proxy
.
proxy
(
Maybe
UserLight
)
->
UserId
->
GargServer
UserAPI
userAPI
_p
uId
=
withAccess
(
Proxy
::
Proxy
(
Maybe
UserLight
))
Proxy
uId
(
PathUser
uId
)
userAPI'
where
userAPI'
::
GargServer
UserAPI
userAPI'
=
getUserById
uId
------------------------------------------------------------------------
type
NodeNodeAPI
a
=
Get
'[
J
SON
]
(
Node
a
)
...
...
src/Gargantext/Database/Schema/Node.hs
View file @
1bf17317
...
...
@@ -292,7 +292,6 @@ selectNode id = proc () -> do
returnA
-<
row
runGetNodes
::
Query
NodeRead
->
Cmd
err
[
Node
HyperdataAny
]
runGetNodes
=
runOpaQuery
...
...
src/Gargantext/Database/Schema/User.hs
View file @
1bf17317
...
...
@@ -14,6 +14,7 @@ Functions to deal with users, database side.
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
...
...
@@ -25,15 +26,20 @@ Functions to deal with users, database side.
module
Gargantext.Database.Schema.User
where
import
Control.Arrow
(
returnA
)
import
Control.Lens.TH
(
makeLensesWith
,
abbreviatedFields
)
import
Control.Lens.TH
(
makeLenses
)
import
Data.Aeson.TH
(
deriveJSON
)
import
Data.Eq
(
Eq
(
..
))
import
Data.List
(
find
)
import
Data.Maybe
(
Maybe
)
import
Data.Profunctor.Product.TH
(
makeAdaptorAndInstance
)
import
Data.Swagger
import
Data.Text
(
Text
)
import
Data.Time
(
UTCTime
)
import
GHC.Generics
(
Generic
)
import
GHC.Show
(
Show
(
..
))
import
Gargantext.Core.Types.Individu
(
Username
,
arbitraryUsername
)
import
Gargantext.Core.Utils.Prefix
(
unPrefix
,
unPrefixSwagger
)
import
Gargantext.Database.Utils
import
Gargantext.Prelude
import
Opaleye
...
...
@@ -46,7 +52,11 @@ type UserId = Int
data
UserLight
=
UserLight
{
userLight_id
::
Int
,
userLight_username
::
Text
,
userLight_email
::
Text
}
deriving
(
Show
)
}
deriving
(
Show
,
Generic
)
deriveJSON
(
unPrefix
"userLight_"
)
''
U
serLight
instance
ToSchema
UserLight
where
declareNamedSchema
=
genericDeclareNamedSchema
(
unPrefixSwagger
"userLight_"
)
toUserLight
::
User
->
UserLight
toUserLight
(
User
id
_
_
_
u
_
_
e
_
_
_
)
=
UserLight
id
u
e
...
...
@@ -95,20 +105,21 @@ type UserReadNull = UserPoly (Column (Nullable PGInt4)) (Column (Nul
type
User
=
UserPoly
Int
Text
(
Maybe
UTCTime
)
Bool
Text
Text
Text
Text
Bool
Bool
UTCTime
$
(
makeAdaptorAndInstance
"pUser"
''
U
serPoly
)
$
(
makeLensesWith
abbreviatedFields
''
U
serPoly
)
-- $(makeLensesWith abbreviatedFields ''UserPoly)
makeLenses
''
U
serPoly
userTable
::
Table
UserWrite
UserRead
userTable
=
Table
"auth_user"
(
pUser
User
{
user_id
=
optional
"id"
,
user_password
=
required
"password"
,
user_password
=
Opaleye
.
required
"password"
,
user_lastLogin
=
optional
"last_login"
,
user_isSuperUser
=
required
"is_superuser"
,
user_username
=
required
"username"
,
user_firstName
=
required
"first_name"
,
user_lastName
=
required
"last_name"
,
user_email
=
required
"email"
,
user_isStaff
=
required
"is_staff"
,
user_isActive
=
required
"is_active"
,
user_isSuperUser
=
Opaleye
.
required
"is_superuser"
,
user_username
=
Opaleye
.
required
"username"
,
user_firstName
=
Opaleye
.
required
"first_name"
,
user_lastName
=
Opaleye
.
required
"last_name"
,
user_email
=
Opaleye
.
required
"email"
,
user_isStaff
=
Opaleye
.
required
"is_staff"
,
user_isActive
=
Opaleye
.
required
"is_active"
,
user_dateJoined
=
optional
"date_joined"
}
)
...
...
@@ -175,4 +186,5 @@ usersLight = map toUserLight <$> users
getUser
::
Username
->
Cmd
err
(
Maybe
UserLight
)
getUser
u
=
userLightWithUsername
u
<$>
usersLight
getUserById
::
Int
->
Cmd
err
(
Maybe
UserLight
)
getUserById
uId
=
userLightWithId
uId
<$>
usersLight
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