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