Mercurial > openid

comparison src/ur/openid.ur @ 4:2d409aff8800

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Received an OpenID authentication response, but haven't checked it yet
author Adam Chlipala <adam@chlipala.net>
date Sun, 26 Dec 2010 17:19:52 -0500
parents f59083771ee2
children 443f27cd1572
comparison
equal deleted inserted replaced
3:f59083771ee2 4:2d409aff8800
8 val createInputs = 8 val createInputs =
9 is <- OpenidFfi.createInputs; 9 is <- OpenidFfi.createInputs;
10 OpenidFfi.addInput is "openid.ns" "http://specs.openid.net/auth/2.0"; 10 OpenidFfi.addInput is "openid.ns" "http://specs.openid.net/auth/2.0";
11 return is 11 return is
12 12
13 table associations : { Endpoint : string, Secret : string, Expires : time } 13 table associations : { Endpoint : string, Handle : string, Key : string, Expires : time }
14 PRIMARY KEY Endpoint 14 PRIMARY KEY Endpoint
15 15
16 task periodic 0 = fn () => dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP) 16 task periodic 1 = fn () => dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP)
17 17
18 datatype association = Handle of string | Error of string 18 datatype association = Association of {Handle : string, Key : string} | AssError of string
19 19
20 fun association url = 20 fun association url =
21 secret <- oneOrNoRowsE1 (SELECT (associations.Secret) 21 secret <- oneOrNoRows1 (SELECT associations.Handle, associations.Key
22 FROM associations 22 FROM associations
23 WHERE associations.Endpoint = {[url]}); 23 WHERE associations.Endpoint = {[url]});
24 case secret of 24 case secret of
25 Some v => return (Handle v) 25 Some r => return (Association r)
26 | None => 26 | None =>
27 is <- createInputs; 27 is <- createInputs;
28 OpenidFfi.addInput is "openid.mode" "associate"; 28 OpenidFfi.addInput is "openid.mode" "associate";
29 OpenidFfi.addInput is "openid.assoc_type" "HMAC-SHA256"; 29 OpenidFfi.addInput is "openid.assoc_type" "HMAC-SHA256";
30 OpenidFfi.addInput is "openid.session_type" "no-encryption"; 30 OpenidFfi.addInput is "openid.session_type" "no-encryption";
31 os <- OpenidFfi.indirect url is; 31
32 os <- OpenidFfi.direct url is;
32 case OpenidFfi.getOutput os "error" of 33 case OpenidFfi.getOutput os "error" of
33 Some v => return (Error v) 34 Some v => return (AssError v)
34 | None => 35 | None =>
35 case (OpenidFfi.getOutput os "assoc_handle", OpenidFfi.getOutput os "expires_in") of 36 case (OpenidFfi.getOutput os "assoc_handle", OpenidFfi.getOutput os "mac_key", OpenidFfi.getOutput os "expires_in") of
36 (Some handle, Some expires) => 37 (Some handle, Some key, Some expires) =>
37 (case read expires of 38 (case read expires of
38 None => return (Error "Invalid 'expires_in' field") 39 None => return (AssError "Invalid 'expires_in' field")
39 | Some expires => 40 | Some expires =>
40 tm <- now; 41 tm <- now;
41 dml (INSERT INTO associations (Endpoint, Secret, Expires) 42 dml (INSERT INTO associations (Endpoint, Handle, Key, Expires)
42 VALUES ({[url]}, {[handle]}, {[addSeconds tm expires]})); 43 VALUES ({[url]}, {[handle]}, {[key]}, {[addSeconds tm expires]}));
43 return (Handle handle)) 44 return (Association {Handle = handle, Key = key}))
44 | _ => return (Error "Missing fields in response from OP") 45 | _ => return (AssError "Missing fields in response from OP")
46
47 fun returnTo (qs : option queryString) =
48 case qs of
49 None => error <xml>Empty query string for OpenID callback</xml>
50 | Some qs =>
51 os <- OpenidFfi.indirect qs;
52 case OpenidFfi.getOutput os "openid.error" of
53 Some v => error <xml>Authentication failed: {[v]}</xml>
54 | None =>
55 case OpenidFfi.getOutput os "openid.identity" of
56 None => error <xml>Missing identity in OP response</xml>
57 | Some v => return <xml>Identity: {[v]}</xml>
58
59 fun authenticate id =
60 dy <- discover id;
61 case dy of
62 None => return "Discovery failed"
63 | Some dy =>
64 assoc <- association dy.Endpoint;
65 case assoc of
66 AssError msg => return msg
67 | Association assoc =>
68 redirect (bless (dy.Endpoint ^ "?openid.ns=http://specs.openid.net/auth/2.0&openid.mode=checkid_setup&openid.claimed_id="
69 ^ id ^ "&openid.identity=http://specs.openid.net/auth/2.0/identifier_select&openid.assoc_handle="
70 ^ assoc.Handle ^ "&openid.return_to=" ^ show (effectfulUrl returnTo)))