WIP add permissions page
This commit is contained in:
parent
33de595b9f
commit
0c896046d0
|
@ -9,7 +9,8 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
module Datarekisteri.Frontend.Handlers
|
module Datarekisteri.Frontend.Handlers
|
||||||
( module Datarekisteri.Frontend.Handlers.Profile
|
( module Datarekisteri.Frontend.Handlers.Permissions
|
||||||
|
, module Datarekisteri.Frontend.Handlers.Profile
|
||||||
, module Datarekisteri.Frontend.Handlers.Applications
|
, module Datarekisteri.Frontend.Handlers.Applications
|
||||||
, module Datarekisteri.Frontend.Handlers.Apply
|
, module Datarekisteri.Frontend.Handlers.Apply
|
||||||
, module Datarekisteri.Frontend.Handlers.Members
|
, module Datarekisteri.Frontend.Handlers.Members
|
||||||
|
@ -23,6 +24,7 @@ import Yesod
|
||||||
import Yesod.Auth
|
import Yesod.Auth
|
||||||
|
|
||||||
import Datarekisteri.Frontend.Handlers.Profile
|
import Datarekisteri.Frontend.Handlers.Profile
|
||||||
|
import Datarekisteri.Frontend.Handlers.Permissions
|
||||||
import Datarekisteri.Frontend.Handlers.Apply
|
import Datarekisteri.Frontend.Handlers.Apply
|
||||||
import Datarekisteri.Frontend.Handlers.Applications
|
import Datarekisteri.Frontend.Handlers.Applications
|
||||||
import Datarekisteri.Frontend.Handlers.VerifyEmail
|
import Datarekisteri.Frontend.Handlers.VerifyEmail
|
||||||
|
|
|
@ -0,0 +1,62 @@
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Datarekisteri.Frontend.Handlers.Permissions where
|
||||||
|
|
||||||
|
import Relude hiding (id)
|
||||||
|
|
||||||
|
import Data.Morpheus.Client (raw, declareLocalTypesInline)
|
||||||
|
|
||||||
|
import Yesod
|
||||||
|
import Yesod.Auth
|
||||||
|
|
||||||
|
import Datarekisteri.Core.Types
|
||||||
|
import Datarekisteri.Frontend.ApiRequests
|
||||||
|
import Datarekisteri.Frontend.Types
|
||||||
|
import Datarekisteri.Frontend.Widgets
|
||||||
|
|
||||||
|
declareLocalTypesInline "schema.gql" [raw|
|
||||||
|
query PermissionsPage($id: UserID!) {
|
||||||
|
user(id: $id) {
|
||||||
|
id
|
||||||
|
name
|
||||||
|
nickname
|
||||||
|
permissions {
|
||||||
|
scope
|
||||||
|
permission
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|]
|
||||||
|
|
||||||
|
-- declareLocalTypesInline "schema.gql" [raw|
|
||||||
|
-- mutation UpdatePermissions($user: UserID, $permissions: [InputScopePermission!]!) {
|
||||||
|
-- update(user: $user, permissions: $permissions) {
|
||||||
|
-- id
|
||||||
|
-- }
|
||||||
|
-- }
|
||||||
|
-- |]
|
||||||
|
|
||||||
|
getPermissionsR :: UserID -> Handler Html
|
||||||
|
getPermissionsR userID = defaultLayout $ do
|
||||||
|
PermissionsPage {..} <- liftHandler $ apiRequest True (PermissionsPageArgs {id = userID})
|
||||||
|
PermissionsPageUser {..} <- maybe undefined pure user
|
||||||
|
let permissions' = (\PermissionsPageUserPermissions {..} -> (show scope, show permission) :: (Text, Text)) <$> permissions
|
||||||
|
setTitle "Käyttöoikeudet"
|
||||||
|
[whamlet|
|
||||||
|
<h1>
|
||||||
|
Käyttöoikeudet
|
||||||
|
^{keyValueTable permissions'}
|
||||||
|
|]
|
||||||
|
|
||||||
|
postPermissionsR :: UserID -> Handler Html
|
||||||
|
postPermissionsR = undefined
|
|
@ -54,7 +54,8 @@ instance PathPiece UserID where
|
||||||
mkYesodData "DataIdClient" [parseRoutes|
|
mkYesodData "DataIdClient" [parseRoutes|
|
||||||
/ HomeR GET
|
/ HomeR GET
|
||||||
|
|
||||||
/profile/#UserID ProfileR GET POST
|
/user/#UserID/profile ProfileR GET POST
|
||||||
|
/user/#UserID/permissions PermissionsR GET POST
|
||||||
/update-password/#UserID UpdatePasswordR POST
|
/update-password/#UserID UpdatePasswordR POST
|
||||||
/verify-email VerifyEmailR GET POST
|
/verify-email VerifyEmailR GET POST
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue