adam@0: task initialize = fn () => OpenidFfi.init adam@1: adam@2: fun discover s = adam@2: r <- OpenidFfi.discover s; adam@2: return (Option.mp (fn r => {Endpoint = OpenidFfi.endpoint r, adam@2: LocalId = OpenidFfi.localId r}) r) adam@3: adam@3: val createInputs = adam@3: is <- OpenidFfi.createInputs; adam@3: OpenidFfi.addInput is "openid.ns" "http://specs.openid.net/auth/2.0"; adam@3: return is adam@3: adam@4: table associations : { Endpoint : string, Handle : string, Key : string, Expires : time } adam@3: PRIMARY KEY Endpoint adam@3: adam@4: task periodic 1 = fn () => dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP) adam@3: adam@4: datatype association = Association of {Handle : string, Key : string} | AssError of string adam@3: adam@3: fun association url = adam@4: secret <- oneOrNoRows1 (SELECT associations.Handle, associations.Key adam@3: FROM associations adam@3: WHERE associations.Endpoint = {[url]}); adam@3: case secret of adam@4: Some r => return (Association r) adam@3: | None => adam@3: is <- createInputs; adam@3: OpenidFfi.addInput is "openid.mode" "associate"; adam@3: OpenidFfi.addInput is "openid.assoc_type" "HMAC-SHA256"; adam@3: OpenidFfi.addInput is "openid.session_type" "no-encryption"; adam@4: adam@4: os <- OpenidFfi.direct url is; adam@3: case OpenidFfi.getOutput os "error" of adam@4: Some v => return (AssError v) adam@3: | None => adam@4: case (OpenidFfi.getOutput os "assoc_handle", OpenidFfi.getOutput os "mac_key", OpenidFfi.getOutput os "expires_in") of adam@4: (Some handle, Some key, Some expires) => adam@3: (case read expires of adam@4: None => return (AssError "Invalid 'expires_in' field") adam@3: | Some expires => adam@3: tm <- now; adam@4: dml (INSERT INTO associations (Endpoint, Handle, Key, Expires) adam@4: VALUES ({[url]}, {[handle]}, {[key]}, {[addSeconds tm expires]})); adam@4: return (Association {Handle = handle, Key = key})) adam@4: | _ => return (AssError "Missing fields in response from OP") adam@4: adam@4: fun returnTo (qs : option queryString) = adam@4: case qs of adam@4: None => error Empty query string for OpenID callback adam@4: | Some qs => adam@4: os <- OpenidFfi.indirect qs; adam@4: case OpenidFfi.getOutput os "openid.error" of adam@4: Some v => error Authentication failed: {[v]} adam@4: | None => adam@4: case OpenidFfi.getOutput os "openid.identity" of adam@4: None => error Missing identity in OP response adam@4: | Some v => return Identity: {[v]} adam@4: adam@4: fun authenticate id = adam@4: dy <- discover id; adam@4: case dy of adam@4: None => return "Discovery failed" adam@4: | Some dy => adam@4: assoc <- association dy.Endpoint; adam@4: case assoc of adam@4: AssError msg => return msg adam@4: | Association assoc => adam@4: redirect (bless (dy.Endpoint ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id=" adam@4: ^ id ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle=" adam@4: ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo)))