--- /dev/null
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel assocs namespaces accessors db db.tuples urls
+http.server.dispatchers
+furnace.asides furnace.actions furnace.auth furnace.auth.providers ;
+IN: furnace.auth.features.deactivate-user
+
+: <deactivate-user-action> ( -- action )
+ <action>
+ [
+ logged-in-user get
+ 1 >>deleted
+ t >>changed?
+ drop
+ URL" $realm" end-aside
+ ] >>submit ;
+
+: allow-deactivation ( realm -- realm )
+ <deactivate-user-action> "deactivate-user" add-responder ;
+
+: allow-deactivation? ( -- ? )
+ realm get responders>> "deactivate-user" swap key? ;
</t:form>
+ <t:if t:code="furnace.auth.features.deactivate-user:allow-deactivation?">
+ <t:button t:action="$realm/deactivate-user">Delete User</t:button>
+ </t:if>
</t:chloe>
realm get init-user-profile
URL" $realm" <redirect>
- ] >>submit ;
+ ] >>submit
+ <auth-boilerplate> ;
: allow-registration ( login -- login )
- <register-action> <auth-boilerplate> "register" add-responder ;
+ <register-action> "register" add-responder ;
: allow-registration? ( -- ? )
realm get responders>> "register" swap key? ;
CHLOE: call-next-template drop call-next-template ;
: attr>word ( value -- word/f )
- dup ":" split1 swap lookup
- [ ] [ "No such word: " swap append throw ] ?if ;
+ ":" split1 swap lookup ;
: if-satisfied? ( tag -- ? )
- [ "code" optional-attr [ attr>word execute ] [ t ] if* ]
+ [ "code" optional-attr [ attr>word dup [ execute ] when ] [ t ] if* ]
[ "value" optional-attr [ value ] [ t ] if* ]
bi and ;
<action>
[
validate-username
- "username" value <user> select-tuple 1 >>deleted update-tuple
+ "username" value <user> delete-tuples
URL" $user-admin" <redirect>
] >>submit ;
furnace.auth.features.edit-profile
furnace.auth.features.recover-password
furnace.auth.features.registration
+furnace.auth.features.deactivate-user
furnace.boilerplate
furnace.redirection
webapps.blogs
allow-registration
allow-password-recovery
allow-edit-profile
+ allow-deactivation
<boilerplate>
{ factor-website "page" } >>template
test-db <alloy> ;