Log user in after registration
parent
78008e9904
commit
55b450f371
|
@ -3,7 +3,7 @@
|
||||||
USING: accessors assocs namespaces kernel sequences sets
|
USING: accessors assocs namespaces kernel sequences sets
|
||||||
destructors combinators fry logging
|
destructors combinators fry logging
|
||||||
io.encodings.utf8 io.encodings.string io.binary random
|
io.encodings.utf8 io.encodings.string io.binary random
|
||||||
checksums checksums.sha2
|
checksums checksums.sha2 urls
|
||||||
html.forms
|
html.forms
|
||||||
http.server
|
http.server
|
||||||
http.server.filters
|
http.server.filters
|
||||||
|
@ -60,6 +60,10 @@ TUPLE: realm < dispatcher name users checksum secure ;
|
||||||
|
|
||||||
GENERIC: login-required* ( description capabilities realm -- response )
|
GENERIC: login-required* ( description capabilities realm -- response )
|
||||||
|
|
||||||
|
GENERIC: user-registered ( user realm -- response )
|
||||||
|
|
||||||
|
M: object user-registered 2drop URL" $realm" <redirect> ;
|
||||||
|
|
||||||
GENERIC: init-realm ( realm -- )
|
GENERIC: init-realm ( realm -- )
|
||||||
|
|
||||||
GENERIC: logged-in-username ( realm -- username )
|
GENERIC: logged-in-username ( realm -- username )
|
||||||
|
|
|
@ -33,8 +33,7 @@ IN: furnace.auth.features.registration
|
||||||
users new-user [ user-exists ] unless*
|
users new-user [ user-exists ] unless*
|
||||||
|
|
||||||
realm get init-user-profile
|
realm get init-user-profile
|
||||||
|
realm get user-registered
|
||||||
URL" $realm" <redirect>
|
|
||||||
] >>submit
|
] >>submit
|
||||||
<auth-boilerplate>
|
<auth-boilerplate>
|
||||||
<secure-realm-only> ;
|
<secure-realm-only> ;
|
||||||
|
|
|
@ -104,6 +104,9 @@ M: login-realm login-required* ( description capabilities login -- response )
|
||||||
URL" $realm/login" <continue-conversation>
|
URL" $realm/login" <continue-conversation>
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
|
M: login-realm user-registered ( user realm -- )
|
||||||
|
drop successful-login ;
|
||||||
|
|
||||||
: <login-realm> ( responder name -- auth )
|
: <login-realm> ( responder name -- auth )
|
||||||
login-realm new-realm
|
login-realm new-realm
|
||||||
<login-action> "login" add-responder
|
<login-action> "login" add-responder
|
||||||
|
|
Loading…
Reference in New Issue