basis/furnace/auth/providers/providers.factor

   1 ! Copyright (C) 2008 Slava Pestov.\r
   2 ! See http://factorcode.org/license.txt for BSD license.\r
   3 USING: kernel accessors random math.parser locals\r
   4 sequences math ;\r
   5 IN: furnace.auth.providers\r
   6 \r
   7 TUPLE: user\r
   8 username realname\r
   9 password salt\r
  10 email ticket capabilities profile deleted changed? ;\r
  11 \r
  12 : <user> ( username -- user )\r
  13     user new\r
  14         swap >>username\r
  15         0 >>deleted ;\r
  16 \r
  17 GENERIC: get-user ( username provider -- user/f )\r
  18 \r
  19 GENERIC: update-user ( user provider -- )\r
  20 \r
  21 GENERIC: new-user ( user provider -- user/f )\r
  22 \r
  23 ! Password recovery support\r
  24 \r
  25 :: issue-ticket ( email username provider -- user/f )\r
  26     [let | user [ username provider get-user ] |\r
  27         user [\r
  28             user email>> length 0 > [\r
  29                 user email>> email = [\r
  30                     user\r
  31                     256 random-bits >hex >>ticket\r
  32                     dup provider update-user\r
  33                 ] [ f ] if\r
  34             ] [ f ] if\r
  35         ] [ f ] if\r
  36     ] ;\r
  37 \r
  38 :: claim-ticket ( ticket username provider -- user/f )\r
  39     [let | user [ username provider get-user ] |\r
  40         user [\r
  41             user ticket>> ticket = [\r
  42                 user f >>ticket dup provider update-user\r
  43             ] [ f ] if\r
  44         ] [ f ] if\r
  45     ] ;\r
  46 \r
  47 ! For configuration\r
  48 \r
  49 : add-user ( provider user -- provider )\r
  50     over new-user [ "User exists" throw ] when ;\r