implementation module UserDB

import StdEnv, Maybe
import StdGeneric
import Time, File, Error, Config, Util
import IWorld

from SystemTypes import :: Password(..)

derive bimap (,), Maybe

instance UserDB IWorld
where
	getUser :: !UserId !*IWorld -> (!Maybe User,!*IWorld)
	getUser "root" iworld
		= (Just RootUser,iworld)
	getUser userName iworld
		# (details, iworld) = readUserStore iworld
		= case filter (\d -> (==) (NamedUser userName) (RegisteredUser d)) details of
			[x] = (Just (RegisteredUser x),iworld)
			_	= (Nothing,iworld)
	
	getUserDetails :: !User !*IWorld -> (!Maybe UserDetails,!*IWorld)
	getUserDetails RootUser iworld=:{IWorld|config}
		= (Just {UserDetails
			|userName = "root"
			,password = Password config.rootPassword
			,displayName = "Root User"
			,emailAddress = EmailAddress config.rootEmail
			,roles = Nothing},iworld)
			
	getUserDetails (RegisteredUser details) iworld = (Just details,iworld)
	getUserDetails (NamedUser username) iworld
		# (details, iworld) = readUserStore iworld
		= case filter (\d -> (==) (NamedUser username) (RegisteredUser d)) details of
			[x] = (Just x,iworld)
			_	= (Nothing,iworld)
	getUserDetails _ iworld = (Nothing,iworld)
			
	getUsers :: !*IWorld -> (![User], !*IWorld)
	getUsers iworld
		# (details, iworld) = readUserStore iworld
		= (map (\d -> RegisteredUser d) details,iworld)	//Do not include the "root" user"
		
	getUsersWithRole :: !String !*IWorld -> (![User], !*IWorld)
	getUsersWithRole role iworld
		# (details, iworld)		= readUserStore iworld
		= ([(RegisteredUser d) \\ d <- details | isMember role (mb2list d.UserDetails.roles)], iworld)
		
	authenticateUser :: !String !String	!*IWorld -> (!Maybe User, !*IWorld)
	authenticateUser username password iworld
		| username == "root"
			| password	== iworld.config.rootPassword
				= (Just RootUser, iworld)
			| otherwise
				= (Nothing, iworld)
		| otherwise
			# (details, iworld)	= readUserStore iworld
			= case [(RegisteredUser d) \\ d <- details | d.userName == username && d.UserDetails.password == (Password password)] of
				[user]	= (Just user, iworld)		
				_		= (Nothing, iworld)
	
	createUser :: !UserDetails !*IWorld -> (!MaybeErrorString User,!*IWorld)
	createUser details iworld
		# (store, iworld)		= readUserStore iworld
		| isMember (details.userName) [u.userName \\ u <- store]
			= (Error ("A user with username '" +++ details.userName +++ "' already exists."), iworld)
		# (store, iworld)		= userStore (\_-> store ++ [details]) iworld
		= (Ok (RegisteredUser details),iworld)
		
	updateUser :: !User !UserDetails !*IWorld -> (!User,!*IWorld)
	updateUser match details iworld
		# (store,iworld)		= userStore (map (update match details)) iworld
		= (RegisteredUser details,iworld)
	where
		update match details old	= if (RegisteredUser old == match) details old
	
	deleteUser :: !User !*IWorld -> (!User,!*IWorld)
	deleteUser user iworld
		# (store,iworld)		= userStore delete iworld
		= (user,iworld)
	where
		delete details	= filter (\d -> (RegisteredUser d) <> user) details
		
	lastChange :: !*IWorld -> (!Timestamp,!*IWorld)
	lastChange iworld =:{IWorld|application,world}
		# ((ts,_),world) = readUserFile application world 
		= (ts,{iworld & world = world})
	
//Helper function which finds a property of a certain user
lookupUserProperty :: ![User] !(User -> a) !a !UserId -> a
lookupUserProperty users selectFunction defaultValue userName
		= case [selectFunction user \\ user=:(RegisteredUser d) <- users | d.UserDetails.userName == userName] of
			[x] = x
			_	= defaultValue

userStore :: !([UserDetails] -> [UserDetails]) !*IWorld -> (![UserDetails],!*IWorld) 	
userStore fn iworld=:{IWorld|application,world,timestamp}
	# ((_,users),world)		= readUserFile application world 
	# users					= fn users
	# world					= writeUserFile (timestamp,users) application world
	= (users,{IWorld|iworld & world = world})
where
	writeUserFile users appName world
		# (_, world) = writeFile (appName +++ USER_FILE_POSTFIX) (toString (toJSON users)) world
		= world
		
readUserStore :: !*IWorld -> (![UserDetails],!*IWorld) 	
readUserStore iworld=:{IWorld|application,world}
	# ((Timestamp _,users),world) = readUserFile application world 
	= (users,{IWorld|iworld & world = world})

readUserFile :: !String !*World -> (!(!Timestamp,![UserDetails]),!*World)	
readUserFile appName world
	# (res,world) = readFile (appName +++ USER_FILE_POSTFIX) world
	| isError res = ((Timestamp 0,[]),world)
	= case (fromJSON (fromString (fromOk res))) of
			Just users	= (users,world)
			Nothing		= ((Timestamp 0,[]),world)
		
USER_FILE_POSTFIX :== "-users.json"