basis/furnace/auth/login/permits/permits.factor

   1 USING: accessors namespaces kernel combinators.short-circuit
   2 db.tuples db.types furnace.auth furnace.sessions furnace.cache ;
   3
   4 IN: furnace.auth.login.permits
   5
   6 TUPLE: permit < server-state session uid ;
   7
   8 permit "PERMITS" {
   9     { "session" "SESSION" BIG-INTEGER +not-null+ }
  10     { "uid" "UID" { VARCHAR 255 } +not-null+ }
  11 } define-persistent
  12
  13 : touch-permit ( permit -- )
  14     realm get touch-state ;
  15
  16 : get-permit-uid ( id -- uid )
  17     permit get-state {
  18         [ ]
  19         [ session>> session get id>> = ]
  20         [ [ touch-permit ] [ uid>> ] bi ]
  21     } 1&& ;
  22
  23 : make-permit ( uid -- id )
  24     permit new
  25         swap >>uid
  26         session get id>> >>session
  27     [ touch-permit ] [ insert-tuple ] [ id>> ] tri ;
  28
  29 : delete-permit ( id -- )
  30     permit new-server-state delete-tuples ;