basis/furnace/auth/providers/providers.factor

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