Mercurial > openid

comparison src/ur/openid.ur @ 3:f59083771ee2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Saving associations
author Adam Chlipala <adam@chlipala.net>
date Sun, 26 Dec 2010 15:11:23 -0500
parents b757dc2bd2f6
children 2d409aff8800
comparison
equal deleted inserted replaced
2:b757dc2bd2f6 3:f59083771ee2
2 2
3 fun discover s = 3 fun discover s =
4 r <- OpenidFfi.discover s; 4 r <- OpenidFfi.discover s;
5 return (Option.mp (fn r => {Endpoint = OpenidFfi.endpoint r, 5 return (Option.mp (fn r => {Endpoint = OpenidFfi.endpoint r,
6 LocalId = OpenidFfi.localId r}) r) 6 LocalId = OpenidFfi.localId r}) r)
7
8 val createInputs =
9 is <- OpenidFfi.createInputs;
10 OpenidFfi.addInput is "openid.ns" "http://specs.openid.net/auth/2.0";
11 return is
12
13 table associations : { Endpoint : string, Secret : string, Expires : time }
14 PRIMARY KEY Endpoint
15
16 task periodic 0 = fn () => dml (DELETE FROM associations WHERE Expires < CURRENT_TIMESTAMP)
17
18 datatype association = Handle of string | Error of string
19
20 fun association url =
21 secret <- oneOrNoRowsE1 (SELECT (associations.Secret)
22 FROM associations
23 WHERE associations.Endpoint = {[url]});
24 case secret of
25 Some v => return (Handle v)
26 | None =>
27 is <- createInputs;
28 OpenidFfi.addInput is "openid.mode" "associate";
29 OpenidFfi.addInput is "openid.assoc_type" "HMAC-SHA256";
30 OpenidFfi.addInput is "openid.session_type" "no-encryption";
31 os <- OpenidFfi.indirect url is;
32 case OpenidFfi.getOutput os "error" of
33 Some v => return (Error v)
34 | None =>
35 case (OpenidFfi.getOutput os "assoc_handle", OpenidFfi.getOutput os "expires_in") of
36 (Some handle, Some expires) =>
37 (case read expires of
38 None => return (Error "Invalid 'expires_in' field")
39 | Some expires =>
40 tm <- now;
41 dml (INSERT INTO associations (Endpoint, Secret, Expires)
42 VALUES ({[url]}, {[handle]}, {[addSeconds tm expires]}));
43 return (Handle handle))
44 | _ => return (Error "Missing fields in response from OP")