UserDB.icl 9.3 KB
Newer Older
1 2
implementation module UserDB

3
import StdEnv, StdMaybe
4
import StdGeneric
5
import TSt, Store
6

Bas Lijnse's avatar
Bas Lijnse committed
7 8 9 10 11
unknownUser :: User
unknownUser = {User | userId = -1, userName = "", displayName = "Unknown user", password = "", roles = []}

rootUser :: User
rootUser = {User | userId = 0, userName = "root", displayName = "Root", password = "", roles = []}
Bas Lijnse's avatar
Bas Lijnse committed
12 13 14 15 16 17 18 19 20

//TEMPORARY ALTERNATIVE HARDCODED USER SET
testUsers :: [User]
testUsers = [ {User | userId = 1, userName = "bas", displayName = "Bas", password = "", roles = []}
			, {User | userId = 2, userName = "rinus", displayName = "Rinus", password = "", roles = []}
			, {User | userId = 3, userName = "thomas", displayName = "Thomas", password = "", roles = []}
			, {User | userId = 4, userName = "peter", displayName = "Peter", password = "", roles = []}
			, {User | userId = 5, userName = "pieter", displayName = "Pieter", password = "", roles = []}
			, {User | userId = 6, userName = "janmartin", displayName = "Jan Martin", password = "", roles = []}
21 22 23 24

  			, {User | userId = 20, userName = "megastore", displayName = "Megastore", password = "", roles = ["supplier"]}
			, {User | userId = 21, userName = "localshop", displayName = "Local shop", password = "", roles = ["supplier"]}
			, {User | userId = 22, userName = "webshop", displayName = "Webshop.com", password = "", roles = ["supplier"]}   
25 26 27 28 29 30 31 32 33 34 35 36
			
			, {User | userId = 30, userName = "ambupost0", displayName = "Ambulance Post 0", password = "", roles = ["ambulances"]}
			, {User | userId = 31, userName = "ambupost1", displayName = "Ambulance Post 1", password = "", roles = ["ambulances"]}
			, {User | userId = 32, userName = "ambupost2", displayName = "Ambulance Post 2", password = "", roles = ["ambulances"]}   
			, {User | userId = 33, userName = "ambupost3", displayName = "Ambulance Post 3", password = "", roles = ["ambulances"]}   
			, {User | userId = 34, userName = "ambupost4", displayName = "Ambulance Post 4", password = "", roles = ["ambulances"]}   
			, {User | userId = 35, userName = "ambupost5", displayName = "Ambulance Post 5", password = "", roles = ["ambulances"]}   
			, {User | userId = 36, userName = "ambupost6", displayName = "Ambulance Post 6", password = "", roles = ["ambulances"]}   
			, {User | userId = 37, userName = "ambupost7", displayName = "Ambulance Post 7", password = "", roles = ["ambulances"]}   
			, {User | userId = 38, userName = "ambupost8", displayName = "Ambulance Post 8", password = "", roles = ["ambulances"]}   
			, {User | userId = 39, userName = "ambupost9", displayName = "Ambulance Post 9", password = "", roles = ["ambulances"]}  
			
Bas Lijnse's avatar
Bas Lijnse committed
37 38
			]
/*
39 40
testUsers :: [User] 
testUsers	= [ {User | userId = 1, userName = "president", displayName = "President", password = "", roles = ["president"]}
Bas Lijnse's avatar
Bas Lijnse committed
41 42
			  , {User | userId = 2, userName = "manager", displayName = "Middle manager", password = "", roles = ["manager"]}
			  , {User | userId = 3, userName = "worker1", displayName = "Office worker 1", password = "", roles = ["worker"]}
43
			  
Bas Lijnse's avatar
Bas Lijnse committed
44 45 46 47
			  , {User | userId = 10, userName = "customer", displayName = "Customer", password = "", roles = ["customer"]}
			  , {User | userId = 11, userName = "bank", displayName = "Bank authorization", password = "", roles = ["bank"]}
			  , {User | userId = 12, userName = "storage", displayName = "Webshop storage", password = "", roles = ["storage"]}
			  , {User | userId = 13, userName = "creditcard", displayName = "Creditcard authorization", password = "", roles = ["creditcard"]}    
48
			  
Bas Lijnse's avatar
Bas Lijnse committed
49 50 51
			  , {User | userId = 20, userName = "megastore", displayName = "Megastore", password = "", roles = ["supplier"]}
			  , {User | userId = 21, userName = "localshop", displayName = "Local shop", password = "", roles = ["supplier"]}
			  , {User | userId = 22, userName = "webshop", displayName = "Webshop.com", password = "", roles = ["supplier"]}   
52

Bas Lijnse's avatar
Bas Lijnse committed
53 54 55 56 57 58 59 60 61 62
			  , {User | userId = 30, userName = "ambupost0", displayName = "Ambulance Post 0", password = "", roles = ["ambulances"]}
			  , {User | userId = 31, userName = "ambupost1", displayName = "Ambulance Post 1", password = "", roles = ["ambulances"]}
			  , {User | userId = 32, userName = "ambupost2", displayName = "Ambulance Post 2", password = "", roles = ["ambulances"]}   
			  , {User | userId = 33, userName = "ambupost3", displayName = "Ambulance Post 3", password = "", roles = ["ambulances"]}   
			  , {User | userId = 34, userName = "ambupost4", displayName = "Ambulance Post 4", password = "", roles = ["ambulances"]}   
			  , {User | userId = 35, userName = "ambupost5", displayName = "Ambulance Post 5", password = "", roles = ["ambulances"]}   
			  , {User | userId = 36, userName = "ambupost6", displayName = "Ambulance Post 6", password = "", roles = ["ambulances"]}   
			  , {User | userId = 37, userName = "ambupost7", displayName = "Ambulance Post 7", password = "", roles = ["ambulances"]}   
			  , {User | userId = 38, userName = "ambupost8", displayName = "Ambulance Post 8", password = "", roles = ["ambulances"]}   
			  , {User | userId = 39, userName = "ambupost9", displayName = "Ambulance Post 9", password = "", roles = ["ambulances"]}   
Jan Martin Jansen's avatar
Jan Martin Jansen committed
63

Bas Lijnse's avatar
Bas Lijnse committed
64 65 66 67 68 69 70 71 72 73
			  , {User | userId = 40, userName = "expert0", displayName = "Expert 0", password = "", roles = ["experts"]}
			  , {User | userId = 41, userName = "expert1", displayName = "Expert 1", password = "", roles = ["experts"]}
			  , {User | userId = 42, userName = "expert2", displayName = "Expert 2", password = "", roles = ["experts"]}   
			  , {User | userId = 43, userName = "expert3", displayName = "Expert 3", password = "", roles = ["experts"]}   
			  , {User | userId = 44, userName = "expert4", displayName = "Expert 4", password = "", roles = ["experts"]}   
			  , {User | userId = 45, userName = "expert5", displayName = "Expert 5", password = "", roles = ["experts"]}   
			  , {User | userId = 46, userName = "expert6", displayName = "Expert 6", password = "", roles = ["experts"]}   
			  , {User | userId = 47, userName = "expert7", displayName = "Expert 7", password = "", roles = ["experts"]}   
			  , {User | userId = 48, userName = "expert8", displayName = "Expert 8", password = "", roles = ["experts"]}   
			  , {User | userId = 49, userName = "expert9", displayName = "Expert 9", password = "", roles = ["experts"]}   
Bas Lijnse's avatar
Bas Lijnse committed
74 75 76
			  ]	
*/

Bas Lijnse's avatar
Bas Lijnse committed
77
getUser :: !Int !*TSt -> (!User,!*TSt)
78 79
getUser 0 tst
	= (rootUser,tst)
Bas Lijnse's avatar
Bas Lijnse committed
80 81 82 83 84 85
getUser uid tst
	# (users, tst)		= userStore id tst
	= case filter (\u -> u.User.userId == uid) users of
		[x] = (x,tst)
		_	= (unknownUser,tst)

Bas Lijnse's avatar
Bas Lijnse committed
86 87 88 89 90 91 92 93 94
getUserByName :: !String !*TSt -> (!User, !*TSt)
getUserByName "root" tst
	= (rootUser,tst)
getUserByName name tst
	# (users, tst)		= userStore id tst
	= case filter (\u -> u.User.userName == name) users of
		[x] = (x,tst)
		_	= (unknownUser,tst)

Bas Lijnse's avatar
Bas Lijnse committed
95 96
getUsers :: !*TSt -> (![User], !*TSt)
getUsers tst
97 98 99
	# (users, tst) = userStore id tst
	= (users,tst)	//Do not include the "root" user"
	
Bas Lijnse's avatar
Bas Lijnse committed
100 101 102
getUsersWithRole :: !String !*TSt -> (![User], !*TSt)
getUsersWithRole role tst
	# (users, tst)		= userStore id tst
103
	= (filter (\u -> isMember role u.User.roles) users, tst) //Do not include the "root" user"
Bas Lijnse's avatar
Bas Lijnse committed
104

Bas Lijnse's avatar
Bas Lijnse committed
105 106 107
getDisplayNames	:: ![Int] !*TSt -> (![String], !*TSt)
getDisplayNames	uids tst
	# (users, tst)		= userStore id tst
108 109 110 111 112
	= (map (displayName users) uids, tst)
where
	displayName users 0 = "Root"
	displayName users uid = lookupUserProperty users (\u -> u.displayName) "Unknown user" uid
	
Bas Lijnse's avatar
Bas Lijnse committed
113 114 115
getUserNames :: ![Int] !*TSt -> (![String], !*TSt)
getUserNames uids tst
	# (users, tst)		= userStore id tst
116 117 118 119 120
	= (map (userName users) uids, tst)
where
	userName users 0 = "root"
	userName users uid = lookupUserProperty users (\u -> u.userName) "" uid
	
Bas Lijnse's avatar
Bas Lijnse committed
121 122 123 124
getRoles :: ![Int] !*TSt -> (![[String]], !*TSt)
getRoles uids tst
	# (users, tst)		= userStore id tst
	= (map (lookupUserProperty users (\u -> u.User.roles) []) uids, tst)
125

Bas Lijnse's avatar
Bas Lijnse committed
126 127
authenticateUser :: !String !String	!*TSt -> (!Maybe User, !*TSt)
authenticateUser username password tst
128 129 130 131 132 133 134 135 136 137
	| username == "root"
		| password	== tst.config.rootPassword
			= (Just rootUser, tst)
		| otherwise
			= (Nothing, tst)
	| otherwise
		# (users, tst)		= userStore id tst
		= case [u \\ u <- users | u.userName == username && u.password == password] of
			[user]	= (Just user, tst)		
			_		= (Nothing, tst)
138

139 140
createUser :: !User !*TSt -> (!User,!*TSt)
createUser user tst
141
	# (users, tst)		= userStore id tst
142
	# user				= {User|user & userId= maxid users}
143 144 145 146 147 148
	# (users, tst)		= userStore (\_-> [user:users]) tst
	= (user,tst)
where
	maxid [] = 1 
	maxid users	= maxList [user.User.userId \\ user <- users] + 1

149 150 151 152 153 154 155 156 157 158 159 160 161 162
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]
	
163 164 165
//Helper function which finds a property of a certain user
lookupUserProperty :: ![User] !(User -> a) !a !Int -> a
lookupUserProperty users selectFunction defaultValue userId
166
		= case [selectFunction user \\ user <- users | user.User.userId == userId] of
167 168 169
			[x] = x
			_	= defaultValue

170
userStore ::  !([User] -> [User]) !*TSt -> (![User],!*TSt) 	
ecrombag's avatar
ecrombag committed
171 172
userStore fn tst=:{TSt|systemStore,world}
	# (mbList,sstore,world)	= loadValue "UserDB" systemStore world
173
	# list 					= fn (case mbList of Nothing = testUsers; Just list = list)
ecrombag's avatar
ecrombag committed
174 175
	# sstore				= storeValue "UserDB" list sstore 
	= (list, {TSt|tst & systemStore = sstore, world = world})