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 ...@@ -4,7 +4,7 @@ definition module UserDBTasks
* of the iTask system. These tasks are useful when work is to be delegated to * of the iTask system. These tasks are useful when work is to be delegated to
* other users. * other users.
*/ */
import StdMaybe import StdMaybe, Void
from TSt import :: Task from TSt import :: Task
from Types import :: UserId from Types import :: UserId
...@@ -48,9 +48,15 @@ authenticateUser :: !String !String -> Task (Maybe User) ...@@ -48,9 +48,15 @@ authenticateUser :: !String !String -> Task (Maybe User)
/** /**
* Add a new 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 //Interactively choose a user
chooseUser :: !question -> Task User | html question chooseUser :: !question -> Task User | html question
......
...@@ -14,6 +14,8 @@ from UserDB import qualified getUserNames ...@@ -14,6 +14,8 @@ from UserDB import qualified getUserNames
from UserDB import qualified getRoles from UserDB import qualified getRoles
from UserDB import qualified authenticateUser from UserDB import qualified authenticateUser
from UserDB import qualified createUser from UserDB import qualified createUser
from UserDB import qualified updateUser
from UserDB import qualified deleteUser
import InteractionTasks, CoreCombinators import InteractionTasks, CoreCombinators
...@@ -41,9 +43,14 @@ getRoles uids = mkInstantTask "getRoles" (UserDB@getRoles uids) ...@@ -41,9 +43,14 @@ getRoles uids = mkInstantTask "getRoles" (UserDB@getRoles uids)
authenticateUser :: !String !String -> Task (Maybe User) authenticateUser :: !String !String -> Task (Maybe User)
authenticateUser username password = mkInstantTask "authenticateUser" (UserDB@authenticateUser username password) authenticateUser username password = mkInstantTask "authenticateUser" (UserDB@authenticateUser username password)
createUser :: !String !String !String ![String] -> Task User createUser :: !User -> Task User
createUser username password displayname roles createUser user = mkInstantTask "createUser" (UserDB@createUser user)
= mkInstantTask "createUser" (UserDB@createUser username password displayname roles)
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 -> Task User | html question
chooseUser question chooseUser question
......
...@@ -27,6 +27,14 @@ eitherTask :: !(Task a) !(Task b) -> Task (Either a b) | iTask a & iTask ...@@ -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 (>>?) 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 (-&?&-) 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 //Task delegation
class (@:) infix 3 u :: u !(LabeledTask a) -> Task a | iTask a class (@:) infix 3 u :: u !(LabeledTask a) -> Task a | iTask a
......
...@@ -98,6 +98,16 @@ where ...@@ -98,6 +98,16 @@ where
combineResult [Left (Just r1),Right (Just r2)] = Just (r1,r2) combineResult [Left (Just r1),Right (Just r2)] = Just (r1,r2)
combineResult _ = Nothing 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 // 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) ...@@ -85,11 +85,32 @@ authenticateUser :: !String !String !*TSt -> (!Maybe User, !*TSt)
/** /**
* Create a new user * Create a new user
* *
* @param A user name * @param A new user
* @param A password * @param A unique database handle
* @param A display name *
* @param A list of roles
* @return A user * @return A user
* @return The database handle * @return The database handle
*/ */
createUser :: !String !String !String ![String] !*TSt -> (User,!*TSt) createUser :: !User !*TSt -> (!User,!*TSt)
\ No newline at end of file
/**
* 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 ...@@ -136,17 +136,30 @@ authenticateUser username password tst
[user] = (Just user, tst) [user] = (Just user, tst)
_ = (Nothing, tst) _ = (Nothing, tst)
createUser :: !User !*TSt -> (!User,!*TSt)
createUser :: !String !String !String ![String] !*TSt -> (User,!*TSt) createUser user tst
createUser username password displayname roles tst
# (users, tst) = userStore id 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 # (users, tst) = userStore (\_-> [user:users]) tst
= (user,tst) = (user,tst)
where where
maxid [] = 1 maxid [] = 1
maxid users = maxList [user.User.userId \\ user <- users] + 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 //Helper function which finds a property of a certain user
lookupUserProperty :: ![User] !(User -> a) !a !Int -> a lookupUserProperty :: ![User] !(User -> a) !a !Int -> a
lookupUserProperty users selectFunction defaultValue userId lookupUserProperty users selectFunction defaultValue userId
......
...@@ -20,11 +20,13 @@ import RPCHandlers, DocumentHandler ...@@ -20,11 +20,13 @@ import RPCHandlers, DocumentHandler
import Config, TSt import Config, TSt
from UserAdmin import userAdministration
PATH_SEP :== "\\" PATH_SEP :== "\\"
// The iTasks engine consist of a set of HTTP request handlers // The iTasks engine consist of a set of HTTP request handlers
engine :: Config [Workflow] -> [(!String -> Bool, HTTPRequest *World -> (!HTTPResponse, !*World))] engine :: Config [Workflow] -> [(!String -> Bool, HTTPRequest *World -> (!HTTPResponse, !*World))]
engine config flows engine config userflows
= [((==) (config.serverPath +++ "/authenticate"), handleAnonRequest config flows handleAuthenticationRequest) = [((==) (config.serverPath +++ "/authenticate"), handleAnonRequest config flows handleAuthenticationRequest)
,((==) (config.serverPath +++ "/deauthenticate"), handleSessionRequest config flows handleDeauthenticationRequest) ,((==) (config.serverPath +++ "/deauthenticate"), handleSessionRequest config flows handleDeauthenticationRequest)
,((==) (config.serverPath +++ "/new/list"), handleSessionRequest config flows handleNewListRequest) ,((==) (config.serverPath +++ "/new/list"), handleSessionRequest config flows handleNewListRequest)
...@@ -42,6 +44,9 @@ engine config flows ...@@ -42,6 +44,9 @@ engine config flows
,((startsWith) (config.serverPath +++ "/document/preview/link"), handleSessionRequest config flows handleDocumentPreviewLinkRequest) ,((startsWith) (config.serverPath +++ "/document/preview/link"), handleSessionRequest config flows handleDocumentPreviewLinkRequest)
,(\_ -> True, handleStaticResourceRequest) ,(\_ -> True, handleStaticResourceRequest)
] ]
where
//Always add the workflows for administering the itask system
flows = userflows ++ userAdministration
workflow :: String (Task a) -> Workflow | iTask a workflow :: String (Task a) -> Workflow | iTask a
workflow path task = workflow path task =
......
...@@ -89,6 +89,7 @@ mkTSt :: String Config HTTPRequest Session ![Workflow] !*Store !*Store !*Store ! ...@@ -89,6 +89,7 @@ mkTSt :: String Config HTTPRequest Session ![Workflow] !*Store !*Store !*Store !
/** /**
* Creates an instance of a task definition * Creates an instance of a task definition
* As soon as an instance is created it is immediately evaluated once.
* *
* @param The task * @param The task
* @param Start as toplevel, or as subtask of another task (parent information is read from the task state) * @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} ...@@ -142,7 +142,6 @@ createTaskInstance task managerProps toplevel tst=:{taskNr,mainTask}
# (_,tst) = calculateTaskTree processId tst # (_,tst) = calculateTaskTree processId tst
= (processId,tst) = (processId,tst)
calculateTaskTree :: !ProcessId !*TSt -> (!TaskTree, !*TSt) calculateTaskTree :: !ProcessId !*TSt -> (!TaskTree, !*TSt)
calculateTaskTree processId tst calculateTaskTree processId tst
# (mbProcess,tst) = getProcess processId tst # (mbProcess,tst) = getProcess processId tst
...@@ -154,7 +153,7 @@ calculateTaskTree processId tst ...@@ -154,7 +153,7 @@ calculateTaskTree processId tst
# (tree,tst=:{activated}) = buildProcessTree process Nothing 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...) //When finished, also evaluate the parent tree (and it's parent when it is also finished etc...)
| activated && parent <> "" | activated && parent <> ""
# (_,tst) = calculateTaskTree parent tst # (_,tst) = calculateTaskTree parent {tst & activated = True}
= (tree, tst) = (tree, tst)
| otherwise | otherwise
= (tree, tst) = (tree, tst)
...@@ -288,19 +287,19 @@ mkInteractiveTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a ...@@ -288,19 +287,19 @@ mkInteractiveTask :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkInteractiveTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkInteractiveTask` mkInteractiveTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkInteractiveTask`
where where
mkInteractiveTask` tst=:{TSt|taskNr,taskInfo} 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 :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkInstantTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkInstantTask` mkInstantTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkInstantTask`
where where
mkInstantTask` tst=:{TSt|taskNr,taskInfo} 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 :: !String !(*TSt -> *(!a,!*TSt)) -> Task a
mkMonitorTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkMonitorTask` mkMonitorTask taskname taskfun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkMonitorTask`
where where
mkMonitorTask` tst=:{TSt|taskNr,taskInfo} 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 :: !String !RPCExecute !(String -> a) -> Task a | gUpdate{|*|} a
mkRpcTask taskname rpce parsefun = Task {TaskDescription| title = taskname, description = Note ""} Nothing mkRpcTask` 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