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