Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file ezSession.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336(* TODO:
* Use a better hash fuction than md5 !!!
*)letdebug=falsemoduleTYPES=structtypeforeign_info={foreign_origin:string;foreign_token:string;}type'user_idsession={session_token:string;session_login:string;session_user_id:'user_id;session_last:float;session_foreign:foreign_infooption;}moduletypeSessionArg=sigtypeuser_idtypeuser_infovaluser_id_encoding:user_idJson_encoding.encodingvaluser_info_encoding:user_infoJson_encoding.encodingvalrpc_path:stringlist(* ["v1"] *)(*
Using a cookie (e.g. `Cookie "EZSESSION" `) allows CSRF (Client-Side
Request Forgery), it is better to use a specific header for security
(`CSRF "X-Csrf-Token" `).
*)valtoken_kind:[`Cookieofstring|`CSRFofstring]endtype('user_id,'user_info)auth={auth_login:string;auth_user_id:'user_id;auth_token:string;auth_user_info:'user_info;}typeauth_needed={challenge_id:string;challenge:string;}type'authconnect_response=|AuthOkof'auth|AuthNeededofauth_neededtypelocal_login_message={login_user:string;login_challenge_id:string;login_challenge_reply:string;}typelogin_message=|Localoflocal_login_message|Foreignofforeign_infotype('user_id,'user_info)login_response=|LoginOkof('user_id,'user_info)auth|LoginWaitof'user_idtypelogin_error=[`Bad_user_or_password|`User_not_registered|`Unverified_user|`Challenge_not_found_or_expiredofstring|`Invalid_session_loginofstring]typelogout_error=[`Invalid_session_logoutofstring]typeconnect_error=[`Session_expired|`Invalid_session_connectofstring]endopenTYPESmoduleHash=structincludeEzHashletpassword~login~password=lets=hash(login^password)inifdebugthenEzDebug.printf"EzSession.Hash.password:\n %S %S => %S"loginpasswords;sletchallenge~challenge~pwhash=lets=hash(challenge^pwhash)inifdebugthenEzDebug.printf"EzSession.Hash.challenge:\n %S %S => %S"challengepwhashs;sendmoduleMake(S:SessionArg)=structtypenonrecauth=(S.user_id,S.user_info)authmoduleEncoding=structopenJson_encodingletauth_needed=def~title:"needed""needed_authentication"@@conv(fun{challenge_id;challenge}->(challenge_id,challenge))(fun(challenge_id,challenge)->{challenge_id;challenge})@@obj2(req"challenge_id"string)(req"challenge"string)letauth_ok=def~title:"success""success_authentication"@@conv(fun{auth_login;auth_user_id;auth_token;auth_user_info}->(auth_login,auth_user_id,auth_token,auth_user_info))(fun(auth_login,auth_user_id,auth_token,auth_user_info)->{auth_login;auth_user_id;auth_token;auth_user_info})@@obj4(req"login"EzEncoding.encoded_string)(req"user_id"S.user_id_encoding)(req"token"string)(req"user_info"S.user_info_encoding)letconnect_response=union[caseauth_ok(functionAuthOkx->Somex|_->None)(funx->AuthOkx);caseauth_needed(functionAuthNeededx->Somex|_->None)(funx->AuthNeededx)]letforeign_message=def~title:"foreign login""foreign_login_message"@@conv(fun{foreign_origin;foreign_token}->(foreign_origin,foreign_token))(fun(foreign_origin,foreign_token)->{foreign_origin;foreign_token})@@obj2(req"auth_origin"string)(req"token"string)letlocal_message=def~title:"local login""local_login_message"@@conv(fun{login_user;login_challenge_id;login_challenge_reply}->(login_user,login_challenge_id,login_challenge_reply))(fun(login_user,login_challenge_id,login_challenge_reply)->{login_user;login_challenge_id;login_challenge_reply})(obj3(req"user"EzEncoding.encoded_string)(req"challenge_id"string)(req"challenge_reply"EzEncoding.encoded_string))letlogin_message=union[caselocal_message(functionLocall->Somel|_->None)(funl->Locall);caseforeign_message(functionForeignf->Somef|_->None)(funf->Foreignf)]letlogin_response=union[caseauth_ok(functionLoginOkx->Somex|_->None)(funx->LoginOkx);case(def~title:"pending""login_validation_pending"@@obj1(req"user_id"S.user_id_encoding))(functionLoginWaitx->Somex|_->None)(funx->LoginWaitx)]letsession_expired_case=EzAPI.Err.Case{code=440;name="SessionExpired";encoding=(obj1(req"error"(constant"SessionExpired")));select=(function`Session_expired->Some()|_->None);deselect=(fun()->`Session_expired);}letbad_user_case=EzAPI.Err.Case{code=401;name="BadUserOrPassword";encoding=(obj1(req"error"(constant"BadUserOrPassword")));select=(function`Bad_user_or_password->Some()|_->None);deselect=(fun()->`Bad_user_or_password);}letuser_not_registered_case=EzAPI.Err.Case{code=400;name="UserNotRegistered";encoding=(obj1(req"error"(constant"UserNotRegistered")));select=(function`User_not_registered->Some()|_->None);deselect=(fun()->`User_not_registered);}letunverified_user_case=EzAPI.Err.Case{code=400;name="UnverifiedUser";encoding=(obj1(req"error"(constant"unverified")));select=(function`Unverified_user->Some()|_->None);deselect=(fun()->`Unverified_user);}letchallenge_not_found_case=EzAPI.Err.Case{code=401;name="ChallengeNotFoundOrExpired";encoding=(obj2(req"error"(constant"ChallengeNotFoundOrExpired"))(req"challenge_id"string));select=(function`Challenge_not_found_or_expireds->Some((),s)|_->None);deselect=(fun((),s)->`Challenge_not_found_or_expireds);}letinvalid_session_login_case=EzAPI.Err.Case{code=400;name="InvalidSession";encoding=(obj2(req"error"(constant"InvalidSession"))(req"reason"string));select=(function`Invalid_session_logins->Some((),s)|_->None);deselect=(fun((),s)->`Invalid_session_logins);}letinvalid_session_logout_case=EzAPI.Err.Case{code=400;name="InvalidSession";encoding=(obj2(req"error"(constant"InvalidSession"))(req"reason"string));select=(function`Invalid_session_logouts->Some((),s));deselect=(fun((),s)->`Invalid_session_logouts);}letinvalid_session_connect_case=EzAPI.Err.Case{code=400;name="InvalidSession";encoding=(obj2(req"error"(constant"InvalidSession"))(req"reason"string));select=(function`Invalid_session_connects->Some((),s)|_->None);deselect=(fun((),s)->`Invalid_session_connects);}endmoduleService=structletsection_session=EzAPI.Doc.section"Session Requests"letparam_token=EzAPI.Param.string~name:"token"~descr:"An authentication token""token"typetoken_security=[EzAPI.Security.cookie|EzAPI.Security.header|EzAPI.Security.query]letparam_security=EzAPI.(`Query{Security.ref_name="Token parameter";name=param_token})letheader_cookie_security=matchS.token_kindwith|`CSRFname->EzAPI.(`Header{Security.ref_name=name^" Header";name})|`Cookiename->EzAPI.(`Cookie{Security.ref_name=name^" Cookie";name})letsecurity:token_securitylist=[param_security;(* Parameter fisrt *)header_cookie_security;(* Header CSRF or Cookie *)]letrpc_root=List.fold_left(funpaths->EzAPI.Path.(path//s))EzAPI.Path.rootS.rpc_pathletconnect:(authconnect_response,connect_error,token_security)EzAPI.service0=EzAPI.service~section:section_session~name:"connect"~output:Encoding.connect_response~errors:[Encoding.session_expired_case;Encoding.invalid_session_connect_case]~securityEzAPI.Path.(rpc_root//"connect")letlogin:(login_message,(S.user_id,S.user_info)login_response,login_error,EzAPI.Security.none)EzAPI.post_service0=EzAPI.post_service~section:section_session~name:"login"~input:Encoding.login_message~output:Encoding.login_response~errors:[Encoding.bad_user_case;Encoding.user_not_registered_case;Encoding.unverified_user_case;Encoding.challenge_not_found_case;Encoding.invalid_session_login_case]EzAPI.Path.(rpc_root//"login")letlogout:(auth_needed,logout_error,token_security)EzAPI.service0=EzAPI.service~section:section_session~name:"logout"~meth:`PUT~output:Encoding.auth_needed~errors:[Encoding.invalid_session_logout_case]~securityEzAPI.Path.(rpc_root//"logout")endend