1 files changed, 42 insertions, 0 deletions
diff --git a/dynamic/captcha.scm b/dynamic/captcha.scm
index f3564a5..99aa0cd 100644
--- a/dynamic/captcha.scm
+++ b/dynamic/captcha.scm
@@ -15,13 +15,20 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (captcha)
+  #:use-module (base64)
+  #:use-module (hashing sha-2)
+  #:use-module (gcrypt mac)
+  #:use-module (gcrypt random)
   #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 iconv)
   #:use-module (ice-9 local-eval)
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 threads)
+  #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:export (new-captcha))
 
 (define proc-mutex (make-mutex))
@@ -121,3 +128,38 @@
                                   lower-bound
                                   upper-bound
                                   latex-src)))))
+
+
+
+;; How many zeroes the SHA-256 hash has to be prefixed by to be a valid proof of work.
+(define %hardness 4)
+
+;; This is an ephemeral key. At this point, it doesn't make sense to store keys
+;; locally, since the server process is singular and long-running.
+(define %pow-mac-key (gen-random-bv 64))
+
+(define (proof-of-work)
+  (define challenge
+    (call-with-input-file "/dev/urandom"
+      (lambda (port) (base64-encode (get-bytevector-n port 32)))))
+  (define expiry-timestamp
+    (date->string
+     (time-utc->date (make-time 'time-utc 0 (+ 512 (time-second (current-time)))))
+     "~Y-~m-~d ~H:~M:~S"))
+  (define challenge-signature
+    (sign-data-base64 %pow-mac-key challenge))
+  (define timestamp-signature
+    (sign-data-base64 %pow-mac-key expiry-timestamp))
+  (values challenge challenge-signature expiry-timestamp timestamp-signature))
+
+(define (check-proof-of-work prefix
+                             challenge challenge-signature
+                             expiry-timestamp timestamp-signature)
+  (and (= 32 (string-length prefix))
+       (string-prefix?
+        (string-join (map (lambda (_) "0") (iota %hardness)) "")
+        (sha-256->string (sha-256 (string->bytevector (string-concatenate (list prefix challenge)) "utf8"))))
+       (valid-base64-signature? %pow-mac-key challenge challenge-signature)
+       (valid-base64-signature? %pow-mac-key expiry-timestamp timestamp-signature)
+       (time<=? (current-time)
+                (date->time-utc (string->date expiry-timestamp "~Y-~m-~d ~H:~M:~S")))))