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