diff --git a/basis/furnace/actions/actions-docs.factor b/basis/furnace/actions/actions-docs.factor index 88bacd2c04..af5cac082a 100644 --- a/basis/furnace/actions/actions-docs.factor +++ b/basis/furnace/actions/actions-docs.factor @@ -99,6 +99,8 @@ ARTICLE: "furnace.actions.config" "Furnace action configuration" { { $slot "display" } { "A quotation called after the " { $slot "init" } " quotation in a GET request. This quotation must return an HTTP " { $link response } "." } } { { $slot "validate" } { "A quotation called at the beginning of a POST request to validate POST parameters." } } { { $slot "submit" } { "A quotation called after the " { $slot "validate" } " quotation in a POST request. This quotation must return an HTTP " { $link response } "." } } + { { $slot "replace" } { "A quotation called after the " { $slot "validate" } " quotation in a PUT request. This quotation must return an HTTP " { $link response } "." } } + { { $slot "update" } { "A quotation called after the " { $slot "validate" } " quotation in a PATCH request. This quotation must return an HTTP " { $link response } "." } } } "At least one of the " { $slot "display" } " and " { $slot "submit" } " slots must be set, otherwise the action will be useless." ; diff --git a/basis/furnace/actions/actions.factor b/basis/furnace/actions/actions.factor index 4d3a179942..cdf088ee53 100644 --- a/basis/furnace/actions/actions.factor +++ b/basis/furnace/actions/actions.factor @@ -19,7 +19,7 @@ IN: furnace.actions SYMBOL: rest -TUPLE: action rest init authorize display validate submit ; +TUPLE: action rest init authorize display validate submit update replace ; : new-action ( class -- action ) new [ ] >>init [ ] >>validate [ ] >>authorize ; inline @@ -83,6 +83,26 @@ CONSTANT: revalidate-url-key "__u" ] [ drop <400> ] if ] with-exit-continuation ; +: handle-put ( action -- response ) + '[ + _ dup submit>> [ + [ validate>> call( -- ) ] + [ authorize>> call( -- ) ] + [ replace>> call( -- response ) ] + tri + ] [ drop <400> ] if + ] with-exit-continuation ; + +: handle-patch ( action -- response ) + '[ + _ dup submit>> [ + [ validate>> call( -- ) ] + [ authorize>> call( -- ) ] + [ update>> call( -- response ) ] + tri + ] [ drop <400> ] if + ] with-exit-continuation ; + : handle-rest ( path action -- ) rest>> [ [ "/" join ] dip set-param ] [ drop ] if* ; @@ -93,9 +113,11 @@ CONSTANT: revalidate-url-key "__u" M: action call-responder* ( path action -- response ) [ init-action ] keep request get method>> { - { "GET" [ handle-get ] } - { "HEAD" [ handle-get ] } - { "POST" [ handle-post ] } + { "GET" [ handle-get ] } + { "HEAD" [ handle-get ] } + { "POST" [ handle-post ] } + { "PUT" [ handle-put ] } + { "PATCH" [ handle-patch ] } [ 2drop <405> ] } case ; diff --git a/basis/furnace/auth/auth-docs.factor b/basis/furnace/auth/auth-docs.factor index 58317ee29a..a05dd3c605 100644 --- a/basis/furnace/auth/auth-docs.factor +++ b/basis/furnace/auth/auth-docs.factor @@ -1,7 +1,14 @@ -USING: assocs classes help.markup help.syntax kernel -quotations strings words words.symbol furnace.auth.providers.db -checksums.sha furnace.auth.providers math byte-arrays -http ; +USING: byte-arrays checksums.sha furnace.auth.providers +furnace.auth.providers.db help.markup help.syntax http kernel +math strings vocabs words.symbol ; +"furnace.auth.basic" require +"furnace.auth.features.deactivate-user" require +"furnace.auth.features.edit-profile" require +"furnace.auth.features.recover-password" require +"furnace.auth.features.registration" require +"furnace.auth.login" require +"furnace.auth.providers.assoc" require +"furnace.auth.providers.null" require IN: furnace.auth HELP: @@ -193,8 +200,6 @@ $nl { $subsections "furnace.auth.users" } "Authentication realms can be adorned with additional functionality." { $subsections "furnace.auth.features" } -"An administration tool." -{ $subsections "webapps.user-admin" } "A concrete example." { $subsections "furnace.auth.example" } ; diff --git a/basis/furnace/recaptcha/example/authors.txt b/basis/furnace/recaptcha/example/authors.txt index 7c1b2f2279..28fd95c75e 100644 --- a/basis/furnace/recaptcha/example/authors.txt +++ b/basis/furnace/recaptcha/example/authors.txt @@ -1 +1,2 @@ Doug Coleman +Benjamin Pollack diff --git a/basis/furnace/recaptcha/example/example.factor b/basis/furnace/recaptcha/example/example.factor index 6c2acc541e..41ade9e96a 100644 --- a/basis/furnace/recaptcha/example/example.factor +++ b/basis/furnace/recaptcha/example/example.factor @@ -20,8 +20,8 @@ TUPLE: recaptcha-app < dispatcher recaptcha ; : ( responder -- recaptcha ) "concatenative.org" >>domain - "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key - "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key ; + "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>site-key + "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>secret-key ; : ( -- obj ) \ recaptcha-app new-dispatcher diff --git a/basis/furnace/recaptcha/example/example.xml b/basis/furnace/recaptcha/example/example.xml index 38ac6019e5..4a8ce13eba 100644 --- a/basis/furnace/recaptcha/example/example.xml +++ b/basis/furnace/recaptcha/example/example.xml @@ -1,5 +1,5 @@ - + diff --git a/basis/furnace/recaptcha/recaptcha-docs.factor b/basis/furnace/recaptcha/recaptcha-docs.factor index 3d23979962..2a4be14e1f 100644 --- a/basis/furnace/recaptcha/recaptcha-docs.factor +++ b/basis/furnace/recaptcha/recaptcha-docs.factor @@ -36,7 +36,7 @@ $nl ARTICLE: "furnace.recaptcha" "Recaptcha support for Furnace" "The " { $vocab-link "furnace.recaptcha" } " vocabulary implements support for the recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl -"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your recaptcha account information." $nl +"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "site-key" } ", and " { $slot "secret-key" } " slots of this responder to your recaptcha account information." $nl "Wrapping a responder with recaptcha support:" { $subsections } diff --git a/basis/furnace/recaptcha/recaptcha-tests.factor b/basis/furnace/recaptcha/recaptcha-tests.factor index 2c7f916ffb..ff0f4217b5 100644 --- a/basis/furnace/recaptcha/recaptcha-tests.factor +++ b/basis/furnace/recaptcha/recaptcha-tests.factor @@ -1,10 +1,5 @@ USING: furnace.recaptcha.private tools.test urls ; IN: furnace.recaptcha.tests -{ - url"http://www.google.com/recaptcha/api/challenge" - url"https://www.google.com/recaptcha/api/challenge" -} [ - f recaptcha-url - t recaptcha-url -] unit-test +{ t f } [ "{\"success\": true, \"challenge_ts\": \"2018-09-14T21:12:17Z\", \"hostname\": \"localhost\"}" parse-recaptcha-response ] unit-test +{ f { "invalid-input-secret" } } [ "{\"success\": false, \"error-codes\": [\"invalid-input-secret\"]}" parse-recaptcha-response ] unit-test diff --git a/basis/furnace/recaptcha/recaptcha.factor b/basis/furnace/recaptcha/recaptcha.factor index 1ed5ed67b6..68174c3fb5 100644 --- a/basis/furnace/recaptcha/recaptcha.factor +++ b/basis/furnace/recaptcha/recaptcha.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2009 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors furnace.actions furnace.redirection html.forms -html.templates.chloe.compiler html.templates.chloe.syntax -http.client http.server http.server.filters io.sockets kernel -locals namespaces sequences splitting urls validators -xml.syntax furnace.conversations ; +USING: accessors assocs furnace.actions furnace.conversations +furnace.redirection html.forms html.templates.chloe.compiler +html.templates.chloe.syntax http.client http.server +http.server.filters io.sockets json.reader kernel locals +namespaces sequences splitting urls validators xml.syntax ; IN: furnace.recaptcha -TUPLE: recaptcha < filter-responder domain public-key private-key ; +TUPLE: recaptcha < filter-responder domain secret-key site-key ; SYMBOL: recaptcha-error @@ -21,61 +21,42 @@ M: recaptcha call-responder* > XML-CHUNK[[ - +
>
]] ; -: recaptcha-url ( secure? -- ? ) - "https" "http" ? "://www.google.com/recaptcha/api/challenge" append - recaptcha-error cget [ "?error=" glue ] when* >url ; - -: render-recaptcha ( -- xml ) - secure-connection? recaptcha-url - recaptcha get public-key>> "k" set-query-param (render-recaptcha) ; - : parse-recaptcha-response ( string -- valid? error ) - "\n" split first2 [ "true" = ] dip ; + json> [ "success" of ] [ "error-codes" of ] bi ; -:: (validate-recaptcha) ( challenge response recaptcha -- valid? error ) - recaptcha private-key>> :> private-key +:: (validate-recaptcha) ( response recaptcha -- valid? error ) + recaptcha secret-key>> :> secret-key remote-address get host>> :> remote-ip H{ - { "challenge" challenge } { "response" response } - { "privatekey" private-key } + { "secret" secret-key } { "remoteip" remote-ip } - } url"http://api-verify.recaptcha.net/verify" + } url"https://www.google.com/recaptcha/api/siteverify" http-post nip parse-recaptcha-response ; : validate-recaptcha-params ( -- ) { - { "recaptcha_challenge_field" [ v-required ] } - { "recaptcha_response_field" [ v-required ] } + { "g-recaptcha-response" [ v-required ] } } validate-params ; PRIVATE> -CHLOE: recaptcha drop [ render-recaptcha ] [xml-code] ; +CHLOE: recaptcha drop [ recaptcha get render-recaptcha ] [xml-code] ; : validate-recaptcha ( -- ) begin-conversation validate-recaptcha-params - "recaptcha_challenge_field" value - "recaptcha_response_field" value + "g-recaptcha-response" value recaptcha get (validate-recaptcha) recaptcha-error cset diff --git a/basis/ui/gadgets/editors/editors-docs.factor b/basis/ui/gadgets/editors/editors-docs.factor index dcbbced158..3517d57451 100644 --- a/basis/ui/gadgets/editors/editors-docs.factor +++ b/basis/ui/gadgets/editors/editors-docs.factor @@ -12,7 +12,6 @@ HELP: editor $nl "Editors have the following slots:" { $list - { { $snippet "caret-color" } " - a " { $link color } "." } { { $snippet "caret" } " - a " { $link model } " storing a line/column pair." } { { $snippet "mark" } " - a " { $link model } " storing a line/column pair. If there is no selection, the mark is equal to the caret, otherwise the mark is located at the opposite end of the selection from the caret." } { { $snippet "focused?" } " - a boolean." } diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index b125670334..e508b13f9a 100644 --- a/basis/ui/gadgets/editors/editors.factor +++ b/basis/ui/gadgets/editors/editors.factor @@ -11,7 +11,6 @@ ui.render ui.text ui.theme unicode ; IN: ui.gadgets.editors TUPLE: editor < line-gadget - caret-color caret mark focused? blink blink-timer default-text ; @@ -25,7 +24,6 @@ TUPLE: editor < line-gadget >>mark ; inline : editor-theme ( editor -- editor ) - color: red >>caret-color monospace-font >>font ; inline PRIVATE> @@ -158,11 +156,9 @@ M: editor ungraft* : draw-caret ( editor -- ) dup draw-caret? [ - [ caret-color>> gl-color ] - [ - [ caret-loc ] [ caret-dim ] bi - over v+ gl-line - ] bi + [ editor-caret-color gl-color ] dip + [ caret-loc ] [ caret-dim ] bi + over v+ gl-line ] [ drop ] if ; : selection-start/end ( editor -- start end ) diff --git a/basis/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor index 07fa67aeaa..bf541ea589 100644 --- a/basis/ui/gadgets/frames/frames.factor +++ b/basis/ui/gadgets/frames/frames.factor @@ -4,7 +4,7 @@ USING: accessors fry kernel math math.order sequences ui.gadgets ui.gadgets.grids ui.gadgets.grids.private ; IN: ui.gadgets.frames -TUPLE: frame < grid filled-cell ; +TUPLE: frame < grid { filled-cell initial: { 0 0 } } ; ( responder -- responder' ) "concatenative.org" >>domain - factor-recaptcha-public-key get >>public-key - factor-recaptcha-private-key get >>private-key ; + factor-recaptcha-site-key get >>site-key + factor-recaptcha-secret-key get >>secret-key ; : ( -- responder ) concatenative-website new-dispatcher