diff --git a/extra/http/server/auth/admin/admin.factor b/extra/http/server/auth/admin/admin.factor index 2b7fa2b162..c9d2769292 100644 --- a/extra/http/server/auth/admin/admin.factor +++ b/extra/http/server/auth/admin/admin.factor @@ -11,6 +11,7 @@ http.server.forms http.server.components.inspector http.server.components http.server.validators +http.server.sessions http.server.actions http.server.crud http.server ; @@ -19,12 +20,21 @@ IN: http.server.auth.admin : admin-template ( name -- template ) "resource:extra/http/server/auth/admin/" swap ".xml" 3append ; -: ( -- form ) +: ( -- form ) "user"
- "user" admin-template >>edit-template - "user-summary" admin-template >>summary-template + "new-user" admin-template >>edit-template "username" add-field "realname" add-field + "new-password" t >>required add-field + "verify-password" t >>required add-field + "email" add-field ; + +: ( -- form ) + "user" + "edit-user" admin-template >>edit-template + "user-summary" admin-template >>summary-template + "username" hidden >>renderer add-field + "realname" add-field "new-password" add-field "verify-password" add-field "email" add-field @@ -33,19 +43,15 @@ IN: http.server.auth.admin : ( -- form ) "user-list" "user-list" admin-template >>view-template - "list" +plain+ add-field ; + "list" +unordered+ add-field ; -:: ( form ctor next -- action ) +:: ( form ctor next -- action ) - { { "username" [ ] } } >>get-params - [ blank-values "username" get ctor call - "username" get [ select-tuple ] when - { [ username>> "username" set-value ] [ realname>> "realname" set-value ] @@ -61,7 +67,49 @@ IN: http.server.auth.admin form validate-form - "username" value find-user + same-password-twice + + user new "username" value >>username select-tuple [ + user-exists? on + validation-failed + ] when + + "username" value + "realname" value >>realname + "email" value >>email + "new-password" value >>password + H{ } clone >>profile + + insert-tuple + + next f + ] >>submit ; + +:: ( form ctor next -- action ) + + { { "username" [ v-required ] } } >>get-params + + [ + blank-values + + "username" get ctor call select-tuple + + { + [ username>> "username" set-value ] + [ realname>> "realname" set-value ] + [ email>> "email" set-value ] + [ profile>> "profile" set-value ] + } cleave + ] >>init + + [ form edit-form ] >>display + + [ + blank-values + + form validate-form + + "username" value select-tuple "realname" value >>realname "email" value >>email @@ -76,13 +124,28 @@ IN: http.server.auth.admin next f ] >>submit ; +:: ( ctor next -- action ) + + { { "username" [ ] } } >>post-params + + [ + "username" get + [ select-tuple 1 >>deleted update-tuple ] + [ logout-all-sessions ] + bi + + next f + ] >>submit ; + TUPLE: user-admin < dispatcher ; :: ( -- responder ) [let | ctor [ [ ] ] | user-admin new-dispatcher ctor "" add-responder - ctor "$user-admin" "edit" add-responder + ctor "$user-admin" "new" add-responder + ctor "$user-admin" "edit" add-responder + ctor "$user-admin" "delete" add-responder "admin" admin-template >>template diff --git a/extra/http/server/auth/admin/admin.xml b/extra/http/server/auth/admin/admin.xml index 1d7a1461fd..d3c0ff4c90 100644 --- a/extra/http/server/auth/admin/admin.xml +++ b/extra/http/server/auth/admin/admin.xml @@ -6,7 +6,7 @@