Permalink
Browse files

Ohm Persona plug-in [prototype]

  • Loading branch information...
1 parent 527eeba commit 795959b4a2f58ae007c4ea1441b9b4775cfbe185 @VictorNicollet committed Mar 29, 2013
Showing with 412 additions and 0 deletions.
  1. +150 −0 ohmPersona/assets/button.htm
  2. +26 −0 ohmPersona/assets/script.coffee
  3. +125 −0 ohmPersona/ohmPersona.ml
  4. +111 −0 ohmPersona/ohmPersona.mli
View
150 ohmPersona/assets/button.htm
@@ -0,0 +1,150 @@
+<a href="javascript:void(0)" onclick="ohmPersonaLogin()" class="persona-button{theme}">
+ <span>{label}</span>
+</a>
+
+<style>
+.persona-linear-gradient(@dir,@from,@to) {
+ background: @to;
+ background: -moz-linear-gradient(@dir, @from, @to);
+ background: -ms-linear-gradient(@dir, @from, @to);
+ background: -o-linear-gradient(@dir, @from, @to);
+ background: -webkit-linear-gradient(@dir, @from, @to);
+ background: linear-gradient(@dir, @to, @from);
+}
+
+.persona-linear-gradient(@from,@to) {
+ .persona-linear-gradient(top,@from,@to);
+ background: linear-gradient(top, @from, @to);
+}
+
+.persona-border-radius(@r) {
+ -moz-border-radius: @r;
+ -ms-border-radius: @r;
+ -o-border-radius: @r;
+ -webkit-border-radius: @r;
+ border-radius: @r;
+}
+
+.persona-box-shadow(@w) {
+ -moz-box-shadow: @w;
+ -ms-box-shadow: @w;
+ -o-box-shadow: @w;
+ -webkit-box-shadow: @w;
+ box-shadow: @w;
+}
+
+.persona-transform(@w) {
+ -moz-transform: @w;
+ -ms-transform: @w;
+ -o-transform: @w;
+ -webkit-transform: @w;
+ transform: @w;
+}
+
+.persona-button {
+
+ color: #fff;
+ display: inline-block;
+ font-size: 14px;
+ font-family: Helvetica, Arial, sans-serif;
+ font-weight: bold;
+ line-height: 1.1;
+ overflow: hidden;
+ position: relative;
+ text-decoration: none;
+ text-shadow: 0 1px rgba(0,0,0,0.5), 0 0 2px rgba(0,0,0,0.2);
+
+ .persona-linear-gradient(#43a6e2,#287cc2);
+ .persona-border-radius(3px);
+ .persona-box-shadow(0 1px 0 rgba(0,0,0,0.2));
+
+
+ &:hover{
+ .persona-linear-gradient(#3788b9,#21669f);
+ }
+
+ &:active, &:focus{
+ top: 1px;
+ .persona-box-shadow(none);
+ }
+
+ span{
+ display: inline-block;
+ padding: 5px 10px 5px 40px;
+ &:after{
+ background: url(data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAA0AAAAPCAYAAAA/I0V3AAAA4klEQVR42o2RWaqEMBRE3YaCiDjPwQGcd9CrysLv4wTyoLFD90dxqbp1EgdPRB7Kskznea6Zn/aPoKoqUUrJOI5m4l2QBfSyLHKep1zXZSae3An1fS/7vst931bGkzuhaZrsLVbGkzuheZ7lOI6HyJ2QUkqv6yrbtv0LT+6E7G0UrfBfP3lZlpoXH4ZBmHgn5Pv+KwxDfqp0XQdgJp6c/RsUBIGOokiSJDE/s21bACbe5Ozp0TdAHMdSFIXUdS1N01C2wpObPT36HifwCJzI0iX29Oh7XP0E3CB9L01TzM+i/wePv4ZE5RtAngAAAABJRU5ErkJggg==) 10px center no-repeat;
+ content: '';
+ display: block;
+ width: 31px;
+ position: absolute;
+ bottom: 0;
+ left: -3px;
+ top: 0;
+ z-index: 10;
+ }
+ &:before{
+ content: '';
+ display: block;
+ height: 100%;
+ width: 20px;
+ position: absolute;
+ bottom: 0;
+ left: 0;
+ top: 0;
+ z-index: 1;
+ .persona-linear-gradient(#50b8e8,#3095ce);
+ .persona-border-radius(3px 0 0 3px);
+ }
+ }
+
+ &:before {
+ background: #42a9dd;
+ content: '';
+ display: block;
+ height: 26px;
+ width: 26px;
+
+ position: absolute;
+ left: 2px;
+ top: 50%;
+ margin-top: -13px;
+ z-index: 0;
+
+ .persona-linear-gradient(-45deg,#50b8e8,#3095ce);
+ .persona-box-shadow(1px -1px 1px rgba(0,0,0,0.1));
+ .persona-transform(rotate(45deg));
+ }
+
+ &:after{
+ content: '';
+ display: block;
+ height: 100%;
+ width: 100%;
+
+ position: absolute;
+ left: 0;
+ top: 0;
+ bottom: 0;
+ right: 0;
+ z-index: 10;
+
+ .persona-border-radius(3px);
+ .persona-box-shadow(inset 0 -1px 0 rgba(0,0,0,0.3));
+ }
+}
+
+.persona-theme(@light,@dark,@hlight,@hdark,@ilight,@idark) {
+ .persona-linear-gradient(@light,@dark);
+ &:hover { .persona-linear-gradient(@hlight,@hdark); }
+ span:before { .persona-linear-gradient(@ilight,@idark); }
+ &:before { .persona-linear-gradient(-45deg,@ilight,@idark); }
+}
+
+.persona-button.dark {
+ .persona-theme(#606060,#3c3c3c,#484848,#2d2d2d,#e4bac45,#d34f2d);
+}
+
+.persona-button.orange{
+ .persona-theme(#ee731a,#d03116,#cb6216,#b12a13,#f7ad27,#e84a21);
+}
+</style>
View
26 ohmPersona/assets/script.coffee
@@ -0,0 +1,26 @@
+#>> ohmPersona(current:string option,login:string,logout:string)
+@ohmPersona = (current,login,logout) ->
+ success = (data) ->
+ for f in data.code
+ eval('(' + f[0] + ')').apply(@,f[1..])
+ navigator.id.watch
+ loggedInUser : current
+ onLogin : (assertion) ->
+ $.ajax
+ url: login
+ contentType: 'application/json'
+ type: 'POST'
+ data: $.toJSON assertion
+ success: success
+ onLogout : () ->
+ $.ajax
+ url: logout
+ type: 'POST'
+ success: success
+
+@ohmPersonaLogin = () ->
+ navigator.id.request()
+
+#>> ohmPersonaLogout()
+@ohmPersonaLogout = () ->
+ navigator.id.logout()
View
125 ohmPersona/ohmPersona.ml
@@ -0,0 +1,125 @@
+(* Ohm is © 2013 Victor Nicollet *)
+
+open Ohm
+open Ohm.Universal
+open BatPervasives
+
+let validate = "https://verifier.login.persona.org/verify"
+
+let script = "https://login.persona.org/include.js"
+
+let head = "<meta http-equiv=\"X-UA-Compatible\" content=\"IE=Edge\">"
+
+let jsActivate ?current ~login ~logout () =
+ Js.ohmPersona ?current ~login ~logout ()
+
+let button ?(theme=`Blue) label =
+ let theme = match theme with
+ | `Blue -> ""
+ | `Dark -> " dark"
+ | `Orange -> " orange"
+ | `Custom s -> " " ^ s
+ in
+ Asset_OhmPersona_Button.render (object
+ method theme = theme
+ method label = label
+ end)
+
+type email = string
+type token = string
+
+type ('ctx,'server,'user) config = <
+ login : ('server,unit) Ohm.Action.endpoint ;
+ logout : ('server,unit) Ohm.Action.endpoint ;
+ cookie : string ;
+ user : token -> ('ctx, 'user option) Ohm.Run.t ;
+ email : 'user -> ('ctx, email option) Ohm.Run.t ;
+> ;;
+
+module ApiResponse = Fmt.Make(struct
+ type json t = <
+ status : [ `okay ] ;
+ email : string ;
+ audience : string ;
+ expires : float ;
+ issuer : string ;
+ >
+end)
+
+let init_full ?(cookie="PERSONA") ?(urlPrefix="persona/") ~server ~onLogin ~onLogout ~user ~email () = (object
+
+ val login = Action.register server (urlPrefix ^ "login") Action.Args.none begin fun req res ->
+
+ let! assertion = req_or (return res)
+ (Action.Convenience.get_json req |> BatOption.bind Fmt.String.of_json_safe) in
+
+ let audience =
+ let domain = server # domain (req # server) in
+ let port = server # port (req # server) in
+ let https = match server # protocol (req # server) with
+ | `HTTP -> false
+ | `HTTPS -> true
+ in
+ Printf.sprintf "%s://%s:%d" (if https then "https" else "http") domain port
+ in
+
+ let! api = req_or (return res) begin
+ try let response = Http_client.Convenience.http_post validate
+ [ "audience", audience ; "assertion", assertion ] in
+ ApiResponse.of_json_string_safe response
+ with _ -> None
+ end in
+
+ let! token, js = ohm (onLogin (req # server) (api # email)) in
+
+ let res = match token with
+ | None -> res
+ | Some token -> Action.with_cookie ~name:cookie ~value:token ~life:0 res
+ in
+
+ return (Action.javascript js res)
+
+ end
+ method login = login
+
+ val logout = Action.register server (urlPrefix ^ "logout") Action.Args.none begin fun req res ->
+
+ let! token = req_or (return res) (req # cookie cookie) in
+ let! js = ohm (onLogout (req # server) token) in
+
+ let res = Action.with_cookie ~name:cookie ~value:"" ~life:0 res in
+ let js = JsCode.seq [ Js.ohmPersonaLogout () ; js ] in
+
+ return (Action.javascript js res)
+
+ end
+ method logout = logout
+
+ method cookie = cookie
+ method user = user
+ method email = email
+
+end :('a,'b,'c) config)
+
+let init ~server ~onLogin ~onLogout ~email =
+ init_full ~server ~onLogin ~onLogout ~user:email ~email:(fun e -> return (Some e)) ()
+
+let token config req =
+ req # cookie (config # cookie)
+
+let user config req =
+ let! token = req_or (return None) (token config req) in
+ config # user token
+
+let auth config req =
+ let! user = ohm (user config req) in
+ let! email = ohm (Run.opt_bind (config # email) user) in
+ let code = jsActivate ?current:email
+ ~login:(Action.url (config # login) (req # server) ())
+ ~logout:(Action.url (config # logout) (req # server) ())
+ ()
+ in
+ return (object
+ method code = code
+ method who = match user, email with Some user, Some email -> Some (user, email) | _ -> None
+ end)
View
111 ohmPersona/ohmPersona.mli
@@ -0,0 +1,111 @@
+(* Ohm is © 2013 Victor Nicollet *)
+
+(** The URL of the Persona JavaScript source. Make sure this source file is
+ included in all paged that use Persona authentication !
+*)
+val script : string
+
+(** A piece of HTML to be included in the page head, which ensures compatibility
+ with IE.
+*)
+val head : string
+
+(** Render a persona login button
+*)
+val button :
+ ?theme:[`Blue|`Dark|`Orange|`Custom of string]
+ -> string
+ -> ('ctx,Ohm.Html.writer) Ohm.Run.t
+
+(** Run the JavaScript code that reacts to the user logging in or logging
+ out. Calls [login] URL as POST with the Persona assertion as its
+ JSON string payload when a login happens. Calls [logout] URL as POST with
+ no payload when a logout happens. [current] should be the e-mail of the
+ currently logged in user.
+*)
+val jsActivate : ?current:string -> login:string -> logout:string -> unit -> Ohm.JsCode.t
+
+type email = string
+type token = string
+
+(** A Persona login/logout configuration object. Represents a configured system
+ that can be used for logging in and logging out users.
+*)
+type ('ctx,'server,'user) config = <
+ login : ('server,unit) Ohm.Action.endpoint ;
+ logout : ('server,unit) Ohm.Action.endpoint ;
+ cookie : string ;
+ user : token -> ('ctx, 'user option) Ohm.Run.t ;
+ email : 'user -> ('ctx, email option) Ohm.Run.t ;
+>
+
+(** Create a Persona login/logout configuration object.
+
+ [cookie] sets the name of the cookie used to store the current
+ authentication token. Default is ["PERSONA"].
+
+ [urlPrefix] is prepended to the URLs for the login and logout
+ endpoints. Default is ["persona/"].
+
+ [server] is the server on which the login and logout actions
+ will be listening. The server is also used to extract the
+ "audience" parameter for the HTTP request.
+
+ [onLogin] is called with the valid e-mail whenever a new login
+ occurs, and should return an authentication token and a piece of
+ javascript to be run on the client (for instance, to redirect
+ to a new page).
+
+ [onLogout] is called whenever a logout occurs, along with the
+ authentication token, and should return a piece of javascript
+ to be run on the client (for instance, to redirect to a
+ login page).
+
+ [user] is called to retrieve an user identifier associated with
+ a certain token.
+
+ [email] is called to retrieve the login e-mail associated with
+ a certain user.
+
+ Note that making this configuration will define two brand new
+ actions (the login and logout endpoints). As such, it should
+ only be called during initialization.
+*)
+val init_full :
+ ?cookie:string
+ -> ?urlPrefix:string
+ -> server:'server Ohm.Action.server
+ -> onLogin:('server -> email -> (unit, token option * Ohm.JsCode.t) Ohm.Run.t)
+ -> onLogout:('server -> token -> (unit, Ohm.JsCode.t) Ohm.Run.t)
+ -> user:(token -> ('ctx, 'user option) Ohm.Run.t)
+ -> email:('user -> ('ctx, email option) Ohm.Run.t)
+ -> unit
+ -> ('ctx, 'server, 'user) config
+
+(** As [init_full], but does not require to specify an user function (the user
+ identifier is assumed to be their email).
+ *)
+val init :
+ server:'server Ohm.Action.server
+ -> onLogin:('server -> email -> (unit, token option * Ohm.JsCode.t) Ohm.Run.t)
+ -> onLogout:('server -> token -> (unit, Ohm.JsCode.t) Ohm.Run.t)
+ -> email:(token -> ('ctx, email option) Ohm.Run.t)
+ -> ('ctx, 'server, email) config
+
+(** Use a Persona configuration object to extract the current
+ authentication token, if any. Note that said authentication token
+ may be invalid, so it still
+*)
+val token : ('ctx, 's, 'u) config -> ('s,'p) Ohm.Action.request -> token option
+
+(** Use a Persona configuration object to extract the current user id
+*)
+val user : ('ctx, 's, 'u) config -> ('s,'p) Ohm.Action.request -> ('ctx,'u option) Ohm.Run.t
+
+(** Runs [jsActivate] with the appropriate parameters and returns the code. Also includes
+ the user and their email. Ideal for calling on every page that requires login.
+*)
+val auth : ('ctx, 's, 'u) config -> ('s,'r) Ohm.Action.request -> ('ctx, <
+ code : Ohm.JsCode.t ;
+ who : ('u * email) option ;
+>) Ohm.Run.t

0 comments on commit 795959b

Please sign in to comment.