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     username provider get-user :> 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 :: claim-ticket ( ticket username provider -- user/f )\r
  38     username provider get-user :> user\r
  39     user [\r
  40         user ticket>> ticket = [\r
  41             user f >>ticket dup provider update-user\r
  42         ] [ f ] if\r
  43     ] [ f ] if ;\r
  44 \r
  45 ! For configuration\r
  46 \r
  47 : add-user ( provider user -- provider )\r
  48     over new-user [ "User exists" throw ] when ;\r