Commit c1f42ee6 authored by Bas Lijnse's avatar Bas Lijnse

Added workflows for user administration. Still very rough, but its a start....

Added workflows for user administration. Still very rough, but its a start. They are always added automatically and need the role "admin" or the root user.

git-svn-id: https://svn.cs.ru.nl/repos/iTask-system/trunk@792 63da3aa8-80fd-4f01-9db8-e6ea747a3da2
parent 5a9e71fe
......@@ -4,7 +4,7 @@ definition module UserDBTasks
* of the iTask system. These tasks are useful when work is to be delegated to
* other users.
*/
import StdMaybe
import StdMaybe, Void
from TSt import :: Task
from Types import :: UserId
......@@ -48,9 +48,15 @@ authenticateUser :: !String !String -> Task (Maybe User)
/**
* Add a new user
*/
createUser :: !String !String !String ![String] -> Task User
createUser :: !User -> Task User
/**
* Update an existing user
*/
updateUser :: !User -> Task User
/**
* Delete an existing user
*/
deleteUser :: !User -> Task User
//Interactively choose a user
chooseUser :: !question -> Task User | html question
......
......@@ -14,6 +14,8 @@ from UserDB import qualified getUserNames
from UserDB import qualified getRoles
from UserDB import qualified authenticateUser
from UserDB import qualified createUser
from UserDB import qualified updateUser
from UserDB import qualified deleteUser
import InteractionTasks, CoreCombinators
......@@ -41,9 +43,14 @@ getRoles uids = mkInstantTask "getRoles" (UserDB@getRoles uids)
authenticateUser :: !String !String -> Task (Maybe User)
authenticateUser username password = mkInstantTask "authenticateUser" (UserDB@authenticateUser username password)
createUser :: !String !String !String ![String] -> Task User
createUser username password displayname roles
= mkInstantTask "createUser" (UserDB@createUser username password displayname roles)
createUser :: !User -> Task User
createUser user = mkInstantTask "createUser" (UserDB@createUser user)
updateUser :: !User -> Task User
updateUser user = mkInstantTask "updateUser" (UserDB@updateUser user)
deleteUser :: !User -> Task User
deleteUser user = mkInstantTask "deleteUser" (UserDB@deleteUser user)
chooseUser :: !question -> Task User | html question
chooseUser question
......
......@@ -27,6 +27,14 @@ eitherTask :: !(Task a) !(Task b) -> Task (Either a b) | iTask a & iTask
(>>?) infixl 1 :: !(Task (Maybe a)) !(a -> Task (Maybe b)) -> Task (Maybe b) | iTask a & iTask b
(-&?&-) infixr 4 :: !(Task (Maybe a)) !(Task (Maybe b)) -> Task (Maybe (a,b)) | iTask a & iTask b
//Post processing of results
ignoreResult :: !(Task a) -> Task Void | iTask a
transformResult :: !(a -> b) !(Task a) -> Task b | iTask a & iTask b
//Synonym for (return Void)
stop :: Task Void
//Task delegation
class (@:) infix 3 u :: u !(LabeledTask a) -> Task a | iTask a
......
......@@ -98,6 +98,16 @@ where
combineResult [Left (Just r1),Right (Just r2)] = Just (r1,r2)
combineResult _ = Nothing
//Post processing of results
ignoreResult :: !(Task a) -> Task Void | iTask a
ignoreResult task = "ignoreResult" @>> (task >>| return Void)
transformResult :: !(a -> b) !(Task a) -> Task b | iTask a & iTask b
transformResult fun task = "transformResult" @>> (task >>= \a -> return (fun a))
stop :: Task Void
stop = "stop" @>> return Void
// ******************************************************************************************************
// repetition
......
definition module UserAdmin
import iTasks
userAdministration :: [Workflow]
\ No newline at end of file
implementation module UserAdmin
import iTasks
userAdministration :: [Workflow]
userAdministration
= [{Workflow|name = "Admin/Create user", label = "Create user ", roles = ["admin"], mainTask = createUserFlow}
,{Workflow|name = "Admin/Update user", label = "Update user", roles = ["admin"], mainTask = updateUserFlow}
,{Workflow|name = "Admin/Delete user", label = "Delete user", roles = ["admin"], mainTask = deleteUserFlow}
]
createUserFlow :: Task Void
createUserFlow
= enterInformationA "Enter user information" [ActionCancel] [ActionOk]
>>= \(action,user) -> case action of
ActionCancel = stop
ActionOk = createUser user
>>| showMessage "Successfully added new user"
updateUserFlow :: Task Void
updateUserFlow
= getUsers
>>= enterChoice "Which user do you want to update?"
>>= updateInformation "Please make your changes"
>>= updateUser
>>| showMessage "Successfully updated user"
deleteUserFlow :: Task Void
deleteUserFlow
= getUsers
>>= enterChoice "Which user do you want to delete?"
>>= deleteUser
>>| showMessage "Successfully deleted user"
\ No newline at end of file
......@@ -85,11 +85,32 @@ authenticateUser :: !String !String !*TSt -> (!Maybe User, !*TSt)
/**
* Create a new user
*
* @param A user name
* @param A password
* @param A display name
* @param A list of roles
* @param A new user
* @param A unique database handle
*
* @return A user
* @return The database handle
*/
createUser :: !String !String !String ![String] !*TSt -> (User,!*TSt)
\ No newline at end of file
createUser :: !User !*TSt -> (!User,!*TSt)
/**
* Update an existing user
*
* @param An existing user
* @param A unique database handle
*
* @return The existing user
* @retrun The database handle
*/
updateUser :: !User !*TSt -> (!User,!*TSt)
/**
* Delete an existing user
*
* @param An existing user
* @param A unique database handle
*
* @return The existing user
* @retrun The database handle
*/
deleteUser :: !User !*TSt -> (!User,!*TSt)
\ No newline at end of file
......@@ -136,17 +136,30 @@ authenticateUser username password tst
[user] = (Just user, tst)
_ = (Nothing, tst)
createUser :: !String !String !String ![String] !*TSt -> (User,!*TSt)
createUser username password displayname roles tst
createUser :: !User !*TSt -> (!User,!*TSt)
createUser user tst
# (users, tst) = userStore id tst
# user = {userId= maxid users, userName = username, password = password, displayName = displayname, roles = roles}
# user = {User|user & userId= maxid users}
# (users, tst) = userStore (\_-> [user:users]) tst
= (user,tst)
where
maxid [] = 1
maxid users = maxList [user.User.userId \\ user <- users] + 1
updateUser :: !User !*TSt -> (!User,!*TSt)
updateUser user tst
# (users,tst) = userStore (map (update user)) tst
= (user,tst)
where
update new old = if (old.User.userId == new.User.userId) new old
deleteUser :: !User !*TSt -> (!User,!*TSt)
deleteUser user tst
# (users,tst) = userStore delete tst
= (user,tst)
where
delete users = [u \\ u <- users | u.User.userId <> user.User.userId]
//Helper function which finds a property of a certain user
lookupUserProperty :: ![User] !(User -> a) !a !Int -> a
lookupUserProperty users selectFunction defaultValue userId
......
......@@ -20,11 +20,13 @@ import RPCHandlers, DocumentHandler
import Config, TSt
from UserAdmin import userAdministration
PATH_SEP :== "\\"
// The iTasks engine consist of a set of HTTP request handlers
engine :: Config [Workflow] -> [(!String -> Bool, HTTPRequest *World -> (!HTTPResponse, !*World))]
engine config flows
engine config userflows
= [((==) (config.serverPath +++ "/authenticate"), handleAnonRequest config flows handleAuthenticationRequest)
,((==) (config.serverPath +++ "/deauthenticate"), handleSessionRequest config flows handleDeauthenticationRequest)
,((==) (config.serverPath +++ "/new/list"), handleSessionRequest config flows handleNewListRequest)
......@@ -42,6 +44,9 @@ engine config flows
,((startsWith) (config.serverPath +++ "/document/preview/link"), handleSessionRequest config flows handleDocumentPreviewLinkRequest)
,(\_ -> True, handleStaticResourceRequest)
]
where
//Always add the workflows for administering the itask system
flows = userflows ++ userAdministration
workflow :: String (Task a) -> Workflow | iTask a
workflow path task =
......
......@@ -89,6 +89,7 @@ mkTSt :: String Config HTTPRequest Session ![Workflow] !*Store !*Store !*Store !
/**
* Creates an instance of a task definition
* As soon as an instance is created it is immediately evaluated once.
*
* @param The task
* @param Start as toplevel, or as subtask of another task (parent information is read from the task state)
......
......@@ -142,7 +142,6 @@ createTaskInstance task managerProps toplevel tst=:{taskNr,mainTask}
# (_,tst) = calculateTaskTree processId tst
= (processId,tst)
calculateTaskTree :: !ProcessId !*TSt -> (!TaskTree, !*TSt)
calculateTaskTree processId tst
# (mbProcess,tst) = getProcess processId tst
......@@ -154,7 +153,7 @@ calculateTaskTree processId tst
# (tree,tst=:{activated}) = buildProcessTree process Nothing tst
//When finished, also evaluate the parent tree (and it's parent when it is also finished etc...)
| activated && parent <> ""
# (_,tst) = calculateTaskTree parent tst
# (_,tst) = calculateTaskTree parent {tst & activated = True}
= (tree, tst)
| otherwise
= (tree, tst)
......@@ -288,19 +287,19 @@ mkInteractiveTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkInteractiveTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkInteractiveTask`
where
mkInteractiveTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTInteractiveTask taskInfo (abort "No interface definition given")}
= taskfun {tst & tree = TTInteractiveTask taskInfo (abort "No interface definition given"), activated = True}
mkInstantTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkInstantTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkInstantTask`
where
mkInstantTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTFinishedTask taskInfo} //We use a FinishedTask node because the task is finished after one evaluation
= taskfun {tst & tree = TTFinishedTask taskInfo, activated = True} //We use a FinishedTask node because the task is finished after one evaluation
mkMonitorTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkMonitorTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkMonitorTask`
where
mkMonitorTask` tst=:{TSt|taskNr,taskInfo}
= taskfun {tst & tree = TTMonitorTask taskInfo []}
= taskfun {tst & tree = TTMonitorTask taskInfo [], activated = True}
mkRpcTask :: !String !RPCExecute !(String -> a) -> Task a | gUpdate{|*|} a
mkRpcTask taskname rpce parsefun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkRpcTask`
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment