Merge remote-tracking branch 'origin/master' into modern-harvey3

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." ;
 

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 ] }
+        { "GET"   [ handle-get ] }
-        { "HEAD" [ handle-get ] }
+        { "HEAD"  [ handle-get ] }
-        { "POST" [ handle-post ] }
+        { "POST"  [ handle-post ] }
+        { "PUT"   [ handle-put ] }
+        { "PATCH" [ handle-patch ] }
         [ 2drop <405> ]
     } case ;
 

basis/furnace/auth/auth-docs.factor

@@ -1,7 +1,14 @@
-USING: assocs classes help.markup help.syntax kernel
+USING: byte-arrays checksums.sha furnace.auth.providers
-quotations strings words words.symbol furnace.auth.providers.db
+furnace.auth.providers.db help.markup help.syntax http kernel
-checksums.sha furnace.auth.providers math byte-arrays
+math strings vocabs words.symbol ;
-http ;
+"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" } ;
 

basis/furnace/recaptcha/example/authors.txt

@@ -1 +1,2 @@
 Doug Coleman
+Benjamin Pollack

basis/furnace/recaptcha/example/example.factor

@@ -20,8 +20,8 @@ TUPLE: recaptcha-app < dispatcher recaptcha ;
 : <test-recaptcha> ( responder -- recaptcha )
     <recaptcha>
         "concatenative.org" >>domain
-        "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
+        "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>site-key
-        "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key ;
+        "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>secret-key ;
 
 : <recaptcha-app> ( -- obj )
     \ recaptcha-app new-dispatcher

basis/furnace/recaptcha/example/example.xml

@@ -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>

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 <recaptcha> }

basis/furnace/recaptcha/recaptcha-tests.factor

@@ -1,10 +1,5 @@
 USING: furnace.recaptcha.private tools.test urls ;
 IN: furnace.recaptcha.tests
 
-{
+{ t f } [ "{\"success\": true, \"challenge_ts\": \"2018-09-14T21:12:17Z\", \"hostname\": \"localhost\"}" parse-recaptcha-response ] unit-test
-    url"http://www.google.com/recaptcha/api/challenge"
+{ f { "invalid-input-secret" } } [ "{\"success\": false, \"error-codes\": [\"invalid-input-secret\"]}" parse-recaptcha-response ] unit-test
-    url"https://www.google.com/recaptcha/api/challenge"
-} [
-    f recaptcha-url
-    t recaptcha-url
-] unit-test

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
+USING: accessors assocs furnace.actions furnace.conversations
-html.templates.chloe.compiler html.templates.chloe.syntax
+furnace.redirection html.forms html.templates.chloe.compiler
-http.client http.server http.server.filters io.sockets kernel
+html.templates.chloe.syntax http.client http.server
-locals namespaces sequences splitting urls validators
+http.server.filters io.sockets json.reader kernel locals
-xml.syntax furnace.conversations ;
+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 )
+: render-recaptcha ( recaptcha -- xml )
-    dup
+    site-key>> XML-CHUNK[[
-    XML-CHUNK[[
         <script type="text/javascript"
-           src=<->>
+           src="https://www.google.com/recaptcha/api.js" async="async" defer="defer">
         </script>
 
-        <noscript>
+        <div class="g-recaptcha" data-sitekey=<->></div>
-           <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>
     ]] ;
 
-: 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 )
+:: (validate-recaptcha) ( response recaptcha -- valid? error )
-    recaptcha private-key>> :> private-key
+    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 ] }
+        { "g-recaptcha-response" [ v-required ] }
-        { "recaptcha_response_field" [ 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
+    "g-recaptcha-response" value
-    "recaptcha_response_field" value
     recaptcha get
     (validate-recaptcha)
     recaptcha-error cset

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." }

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
     <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 ]
+        [ editor-caret-color gl-color ] dip
-        [
+        [ caret-loc ] [ caret-dim ] bi
-            [ caret-loc ] [ caret-dim ] bi
+        over v+ gl-line
-            over v+ gl-line
-        ] bi
     ] [ drop ] if ;
 
 : selection-start/end ( editor -- start end )

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 } } ;
 
 <PRIVATE
 

basis/ui/theme/theme.factor

@@ -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 ;

extra/websites/concatenative/concatenative.factor

@@ -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-site-key get >>site-key
-        factor-recaptcha-private-key get >>private-key ;
+        factor-recaptcha-secret-key get >>secret-key ;
 
 : <concatenative-website> ( -- responder )
     concatenative-website new-dispatcher