dcUser ; 
 ; ----------------------------------------------------------------------------
 ; #
 ; #  DivConq
 ; #
 ; #  http://divconq.com/
 ; #
 ; #  Copyright:
 ; #    Copyright 2012 eTimeline, LLC. All rights reserved.
 ; #
 ; #  License:
 ; #    See the dcLicense.txt file in the project's top-level directory for details.
 ; #
 ; #  Authors:
 ; #    * Andy White
 ; #
 ; ----------------------------------------------------------------------------
 ;
signOn n token,user,pass,code,uid,fnd,confirmed,recoverExpire,at
 i Replication s token=Params("Token"),uid=Params("Uid"),at=Params("At"),confirmed=Params("Confirmed") g storeToken
 ;
 s pass=Params("Password"),user=Params("UserName"),at=Params("At"),code=Params("Code"),recoverExpire=Params("RecoverExpire")   
 ;
 i (user="")!((pass="")&(recoverExpire="")) d err^dcConn(123) quit			
 ;
 s uid=$$loopIndex^dcDb("dcUser","dcUserName",user)
 ;
 i uid="" d err^dcConn(123) quit			
 ; 
 s:pass=$$get3^dcDb("dcUser",uid,"dcPassword") fnd=1
 ;
 i 'fnd d    ; if we get here then recoverExpire must be set
 . i recoverExpire]]$$get1^dcDb("dcUser",uid,"dcRecoverAt") q
 . i (code'="")&($$get1^dcDb("dcUser",uid,"dcConfirmCode")=code) s fnd=1		; we won't clear out the code or rAt fields - they naturally expire
 ;
 i 'fnd d err^dcConn(123) quit
 ;
 i '$$get1^dcDb("dcUser",uid,"dcConfirmed") d
 . i (code'="")&($$get1^dcDb("dcUser",uid,"dcConfirmCode")=code) s Params("Confirmed")=1,confirmed=1 q
 . d err^dcConn(124) q			
 ;
 i Errors quit       ; if any violations then do not proceed
 ;
so2 s Params("Uid")=uid
 s token=$$allocateToken(),Params("Token")=token
 ;
storeToken l +^Session(token)
 s ^Session(token,"__LastAccess")=Stamp
 s ^Session(token,"User")=uid
 l -^Session(token)
 ;
 i confirmed d set1^dcDb("dcUser",uid,"dcConfirmed",1)  
 d set1^dcDb("dcUser",uid,"dcLastLogin",at)   
 ;
 i Replication quit
 ;
 w StartRec
 w Field_"UserId"_ScalarStr_uid
 w Field_"FirstName"_ScalarStr_$$get3^dcDb("dcUser",uid,"dcFirstName")
 w Field_"LastName"_ScalarStr_$$get3^dcDb("dcUser",uid,"dcLastName")
 w Field_"Email"_ScalarStr_$$get3^dcDb("dcUser",uid,"dcEmail")
 w Field_"Locale"_ScalarStr_$$get1^dcDb("dcUser",uid,"dcLocale")
 w Field_"Chronology"_ScalarStr_$$get1^dcDb("dcUser",uid,"dcChronology")
 w Field_"AuthToken"_ScalarStr_token
 w Field_"AuthorizationTags"_StartList
 ;
 d loadUserTags(uid,.tags)
 f  s tag=$o(tags(tag)) q:tag=""  w ScalarStr_tag
 ;
 w EndList
 w EndRec
 ;
 quit
 ;
 ;
startSess n uid,user,token,tags,at
 s user=Params("UserName"),at=Params("At"),uid=Params("UserId")
 ;
 i (user="")&(uid="") d err^dcConn(130) quit			
 ;
 s:uid="" uid=$$loopIndex^dcDb("dcUser","dcUserName",user)
 ;
 i uid="" d err^dcConn(131) quit
 ;
 d so2
 ;
 quit
 ;
 ;
acctTaken n user,uid,sid s sid=$o(Params("Fields","dcUserName","")) 
 s:sid'="" user=Params("Fields","dcUserName",sid,"Data",0)
 i (user="") quit    ; during update, if no user name given that's fine
 ;
 s uid=$$loopIndex^dcDb("dcUser","dcUserName",user)
 i (uid'="")&(uid'=id) d err^dcConn(122) 		
 ;
 quit
 ;
 ;
verify n token,uid,tags,tag,fnd s token=Params("AuthToken"),uid=Params("UserId")
 i (token="")!(uid="") d err^dcConn(120) quit			
 ;
 l +^Session(token)
 s:(uid=^Session(token,"User")) fnd=1 
 s:fnd ^Session(token,"__LastAccess")=Stamp   ; touch the token, will not expire for 30 minutes
 l -^Session(token)
 ;
 i 'fnd d err^dcConn(121) quit
 ;
 w StartRec
 w Field_"AuthorizationTags"_StartList
 ;
 d loadUserTags(uid,.tags)
 f  s tag=$o(tags(tag)) q:tag=""  w ScalarStr_tag
 ;
 w EndList
 w EndRec
 ;
 quit
 ;
 ;
allocateToken() n tid
 ;
 l +^Hub("Token")
 s tid=^Hub("Token")+1
 i tid>999999999999998 s tid=0
 s ^Hub("Token")=tid
 l -^Hub("Token")
 ;
 q ^Hub("Id")_"_"_$$now^dcTimeUtil()_"_"_$$lpad^dcStrUtil(tid,"0",15)_"_"_$$buildCode^dcStrUtil(12)
 ;
 ;
 ;
signOff n token,uid
 s token=Params("AuthToken")
 i (token="") d err^dcConn(117) quit		
 ;
 l +^Session(token)
 k ^Session(token)
 l -^Session(token)
 ;
 quit
 ;
 ;
recovery n user,code,uid,at
 s user=Params("UserName"),at=Params("At"),code=Params("Code")
 ;
 i (user="") d err^dcConn(128) quit			
 ;
 s uid=$$loopIndex^dcDb("dcUser","dcUserName",user)
 ;
 i uid="" d err^dcConn(129) quit			
 ; 
 d set1^dcDb("dcUser",uid,"dcConfirmCode",code)  
 d set1^dcDb("dcUser",uid,"dcRecoverAt",at)   
 ;
 quit
 ;
 ;
unameLookup n user,uid s user=Params("UserName")
 ;
 i (user="") d err^dcConn(118) quit			
 ;
 s uid=$$loopIndex^dcDb("dcUser","dcUserName",user)
 ;
 i (uid="") d err^dcConn(119) quit
 ;
 w StartRec
 w Field_"UserId"_ScalarStr_uid
 w EndRec
 ;
 quit
 ;
 ;
 ;
cleanup n token,cid,pid,expire,expire2
 s expire=Params("ExpireThreshold"),expire2=Params("LongExpireThreshold")
 i (expire="")!(expire2="") d err^dcConn(115) quit			
 ;
 ; TODO enhance so that it does not loop all sessions, does not scale if thousands of concurrent sessions
 f  s token=$o(^Session(token)) q:token=""  d
 . i expire2]]^Session(token,"__LastAccess") d		; only lock if seems probable
 . . l +^Session(token)
 . . k:expire2]]^Session(token,"__LastAccess") ^Session(token)   ; check to be sure, kill expired sessions
 . . l -^Session(token)
 ;
 f  s cid=$o(^Cache(cid)) q:cid=""  d
 . i expire]]^Cache(cid,"__LastAccess") d		; only lock if seems probable
 . . l +^Cache(cid)
 . . k:expire]]^Cache(cid,"__LastAccess") ^Cache(cid)   ; check to be sure, kill expired sessions
 . . l -^Cache(cid)
 ;
 f  s pid=$o(^Params(pid)) q:pid=""  d
 . i expire]]^Params(pid,"__LastAccess") d		; only lock if seems probable
 . . l +^Params(pid)
 . . k:expire]]^Params(pid,"__LastAccess") ^Params(pid)   ; check to be sure, kill expired sessions
 . . l -^Params(pid)
 ;
 quit
 ;
 ;
 ;
 ; record composer
recAuthTags n tags d loadUserTags(id,.tags)
 w StartList
 f  s tag=$o(tags(tag)) q:tag=""  w ScalarStr_tag
 w EndList
 quit
 ;
 ;
 ; select composer
selAuthTags() n tags,ret d loadUserTags(id,.tags)
 s ret=StartList
 f  s tag=$o(tags(tag)) q:tag=""  s ret=ret_ScalarStr_tag
 s ret=ret_EndList
 quit ret
 ;
 ;
 ; where composer
whrAuthTags(lst) n tags,i d loadUserTags(id,.tags)
 f i=1:1 s tag=$o(tags(tag)) q:tag=""  s lst(i)=tag
 quit 
 ;
 ;
 ;
loadUserTags(uid,tags,when) n tlist,tag,glist,gi,gid,i
 ;
 quit:'$$isCurrent^dcDb("dcUser",uid,when) 
 ;
 ; if you are a real user record, and not retired, then you are a User
 s tags("User")=1		
 ;
 d get^dcDb(.tlist,"dcUser",uid,"dcAuthorizationTag",when)
 f  s i=$o(tlist(i)) q:i=""  s:tlist(i)'="" tags(tlist(i))=1
 ;
 d get^dcDb(.glist,"dcUser",uid,"dcGroup",when)
 ;
 f  s gi=$o(glist(gi)) q:gi=""  d
 . s gid=glist(gi) k tlist
 . q:'$$isCurrent^dcDb("dcGroup",gid,when) 
 . d get^dcDb(.tlist,"dcGroup",gid,"dcAuthorizationTag",when)
 . f  s i=$o(tlist(i)) q:i=""  s:tlist(i)'="" tags(tlist(i))=1
 ;
 quit
 ;
 ;
seed w StartRec
 w Field_"Seed"_ScalarStr_^Hub("Seed")
 w EndRec
 quit
 ;
 ;