Merge remote-tracking branch 'origin/master' into modern-harvey3
Doug Coleman
commit
033e136590
|
|
@ -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." ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
|
|
@ -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: <protected>
|
||||
|
|
@ -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" } ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1 +1,2 @@
|
|||
Doug Coleman
|
||||
Benjamin Pollack
|
||||
|
|
|
|||
|
|
@ -20,8 +20,8 @@ TUPLE: recaptcha-app < dispatcher recaptcha ;
|
|||
: <test-recaptcha> ( responder -- recaptcha )
|
||||
<recaptcha>
|
||||
"concatenative.org" >>domain
|
||||
"6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
|
||||
"6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key ;
|
||||
"6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>site-key
|
||||
"6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>secret-key ;
|
||||
|
||||
: <recaptcha-app> ( -- obj )
|
||||
\ recaptcha-app new-dispatcher
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
<?xml version='1.0' ?>
|
||||
<!DOCTYPE html>
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
<html><body><t:form t:action=""><t:recaptcha/></t:form></body></html>
|
||||
<html><body><t:form t:action=""><t:recaptcha/><input type="SUBMIT" value="Done" /></t:form></body></html>
|
||||
</t:chloe>
|
||||
|
|
|
|||
|
|
@ -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 <recaptcha> }
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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*
|
|||
|
||||
<PRIVATE
|
||||
|
||||
: (render-recaptcha) ( url -- xml )
|
||||
dup
|
||||
XML-CHUNK[[
|
||||
: render-recaptcha ( recaptcha -- xml )
|
||||
site-key>> XML-CHUNK[[
|
||||
<script type="text/javascript"
|
||||
src=<->>
|
||||
src="https://www.google.com/recaptcha/api.js" async="async" defer="defer">
|
||||
</script>
|
||||
|
||||
<noscript>
|
||||
<iframe src=<->
|
||||
height="300" width="500" frameborder="0"></iframe><br/>
|
||||
<textarea name="recaptcha_challenge_field" rows="3" cols="40">
|
||||
</textarea>
|
||||
<input type="hidden" name="recaptcha_response_field"
|
||||
value="manual_challenge"/>
|
||||
</noscript>
|
||||
<div class="g-recaptcha" data-sitekey=<->></div>
|
||||
]] ;
|
||||
|
||||
: 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
|
||||
|
|
|
|||
|
|
@ -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." }
|
||||
|
|
|
|||
|
|
@ -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
|
|||
<loc> >>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 )
|
||||
|
|
|
|||
|
|
@ -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 } } ;
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
|
|
|||
|
|
@ -87,6 +87,7 @@ HOOK: vocab-border-color theme ( -- color )
|
|||
|
||||
HOOK: field-border-color theme ( -- color )
|
||||
|
||||
HOOK: editor-caret-color theme ( -- color )
|
||||
HOOK: selection-color theme ( -- color )
|
||||
HOOK: panel-background-color theme ( -- color )
|
||||
HOOK: focus-border-color theme ( -- color )
|
||||
|
|
@ -173,6 +174,7 @@ M: light-theme vocab-border-color color: FactorDarkTan ;
|
|||
|
||||
M: light-theme field-border-color color: gray ;
|
||||
|
||||
M: light-theme editor-caret-color COLOR: red ;
|
||||
M: light-theme selection-color T{ rgba f 0.8 0.8 1.0 1.0 } ;
|
||||
M: light-theme panel-background-color T{ rgba f 0.7843 0.7686 0.7176 1.0 } ;
|
||||
M: light-theme focus-border-color color: dark-gray ;
|
||||
|
|
@ -259,6 +261,7 @@ M: dark-theme vocab-border-color color: solarized-base01 ;
|
|||
|
||||
M: dark-theme field-border-color color: solarized-base01 ;
|
||||
|
||||
M: dark-theme editor-caret-color color: DeepPink2 ;
|
||||
M: dark-theme selection-color color: solarized-base01 ;
|
||||
M: dark-theme panel-background-color T{ rgba f 0.7843 0.7686 0.7176 1.0 } ;
|
||||
M: dark-theme focus-border-color color: solarized-base01 ;
|
||||
|
|
|
|||
|
|
@ -59,13 +59,13 @@ TUPLE: concatenative-website < dispatcher ;
|
|||
allow-edit-profile
|
||||
allow-deactivation ;
|
||||
|
||||
SYMBOLS: factor-recaptcha-public-key factor-recaptcha-private-key ;
|
||||
SYMBOLS: factor-recaptcha-site-key factor-recaptcha-secret-key ;
|
||||
|
||||
: <factor-recaptcha> ( responder -- responder' )
|
||||
<recaptcha>
|
||||
"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 ;
|
||||
|
||||
: <concatenative-website> ( -- responder )
|
||||
concatenative-website new-dispatcher
|
||||
|
|
|
|||
Loading…
Reference in New Issue