basis/furnace/auth/providers/providers.factor

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