basis/furnace/recaptcha/recaptcha.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs furnace.actions furnace.conversations
   4 html.forms html.templates.chloe.compiler
   5 html.templates.chloe.syntax http.client http.server
   6 http.server.filters io.sockets json kernel namespaces urls
   7 validators xml.syntax ;
   8 IN: furnace.recaptcha
   9
  10 TUPLE: recaptcha < filter-responder domain secret-key site-key ;
  11
  12 SYMBOL: recaptcha-error
  13
  14 : <recaptcha> ( responder -- recaptcha )
  15     recaptcha new
  16         swap >>responder ;
  17
  18 M: recaptcha call-responder*
  19     dup recaptcha set
  20     responder>> call-responder ;
  21
  22 <PRIVATE
  23
  24 : render-recaptcha ( recaptcha -- xml )
  25     site-key>> [XML
  26         <script type="text/javascript"
  27            src="https://www.google.com/recaptcha/api.js" async="async" defer="defer">
  28         </script>
  29
  30         <div class="g-recaptcha" data-sitekey=<->></div>
  31     XML] ;
  32
  33 : parse-recaptcha-response ( string -- valid? error )
  34     json> [ "success" of ] [ "error-codes" of ] bi ;
  35
  36 :: (validate-recaptcha) ( response recaptcha -- valid? error )
  37     recaptcha secret-key>> :> secret-key
  38     remote-address get host>> :> remote-ip
  39     H{
  40         { "response" response }
  41         { "secret" secret-key }
  42         { "remoteip" remote-ip }
  43     } URL" https://www.google.com/recaptcha/api/siteverify"
  44     http-post nip parse-recaptcha-response ;
  45
  46 : validate-recaptcha-params ( -- )
  47     {
  48         { "g-recaptcha-response" [ v-required ] }
  49     } validate-params ;
  50
  51 PRIVATE>
  52
  53 CHLOE: recaptcha drop [ recaptcha get render-recaptcha ] [xml-code] ;
  54
  55 : validate-recaptcha ( -- )
  56     begin-conversation
  57     validate-recaptcha-params
  58
  59     "g-recaptcha-response" value
  60     recaptcha get
  61     (validate-recaptcha)
  62     recaptcha-error cset
  63     [ validation-failed ] unless ;