hashcash: improvements by Zoltán Kéri.

[factor.git] / extra / hashcash / hashcash.factor

diff --git a/extra/hashcash/hashcash.factor b/extra/hashcash/hashcash.factor
index a8e597058d25f6984b28546755670b572937b692..06b18347f2ae0f6cf2449b75bafbfbc19a9a0c20 100644 (file)
--- a/extra/hashcash/hashcash.factor
+++ b/extra/hashcash/hashcash.factor
@@ -1,47 +1,50 @@
 ! Copyright (C) 2009 Diego Martinelli.
+! Copyright (C) 2022 Zoltán Kéri.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays calendar checksums
-checksums.openssl classes.tuple formatting io.encodings.ascii
-io.encodings.string kernel literals math math.functions
-math.parser ranges present random sequences splitting ;
+USING: accessors byte-arrays calendar calendar.format
+calendar.parser checksums checksums.openssl classes.tuple
+combinators combinators.short-circuit.smart formatting grouping
+io io.encodings.ascii io.encodings.string io.streams.string
+kernel literals make math math.functions math.parser namespaces
+parser present prettyprint quotations random random.passwords
+ranges sequences sequences.deep splitting strings typed words ;
 IN: hashcash
 
-! Hashcash implementation
-! Reference materials listed below:
-!
-! http://hashcash.org
-! http://en.wikipedia.org/wiki/Hashcash
-! http://www.ibm.com/developerworks/linux/library/l-hashcash.html?ca=dgr-lnxw01HashCash
-!
-! And the reference implementation (in python):
-! http://www.gnosis.cx/download/gnosis/util/hashcash.py
-
 <PRIVATE
 
-! Return a string with today's date in the form YYMMDD
-: get-date ( -- str )
-    now "%y%m%d" strftime ;
+: lastn-digits ( n digits -- string )
+    [ number>string ] dip [ 48 pad-head ] keep tail* ;
 
-! Random salt is formed by ascii characters
-! between 33 and 126
-CONSTANT: available-chars $[
-    CHAR: : 33 126 [a..b] remove >byte-array
-]
+: read-yymmdd ( -- y m d )
+    read-00 now start-of-millennium year>> + read-00 read-00 ;
 
-PRIVATE>
+TYPED: yymmdd-gmt>timestamp ( yymmdd: string -- timestamp )
+    [ read-yymmdd <date-gmt> ] with-string-reader ;
+
+TYPED: timestamp>yymmdd ( timestamp -- yymmdd: string )
+    [ year>> 2 lastn-digits ]
+    [ month>> pad-00 ]
+    [ day>> pad-00 ] tri 3append ;
+
+TYPED: now-gmt-yymmdd ( -- yymmdd: string )
+    now-gmt timestamp>yymmdd ;
 
-! Generate a 'length' long random salt
-: salt ( length -- salted )
-    [ available-chars random ] "" replicate-as ;
+TYPED: yymmdd-gmt-diff ( yymmdd: string yymmdd: string -- days )
+    [ yymmdd-gmt>timestamp ] bi@ time- duration>days ;
+
+TYPED: on-or-before-today? ( yymmdd: string -- x ? )
+    now-gmt-yymmdd swap yymmdd-gmt-diff dup 0 >= ;
+
+PRIVATE>
 
 TUPLE: hashcash version bits date resource ext salt suffix ;
 
 : <hashcash> ( -- tuple )
     hashcash new
-        1 >>version
-        20 >>bits
-        get-date >>date
-        8 salt >>salt ;
+    1 >>version
+    20 >>bits
+    now-gmt-yymmdd >>date
+    8 ascii-password >>salt ;
 
 M: hashcash string>>
     tuple-slots [ present ] map ":" join ;
@@ -78,11 +81,20 @@ PRIVATE>
 
 : mint ( resource -- stamp )
     <hashcash>
-        swap >>resource
+    swap >>resource
     mint* ;
 
-! One might wanna add check based on the date,
-! passing a 'good-until' duration param
-: check-stamp ( stamp -- ? )
-    dup ":" split [ sha1-checksum get-bits ] dip
-    second string>number head all-char-zero? ;
+<PRIVATE
+
+! NOTE: Recommended expiry time is 28 days.
+SYMBOL: expiry-days
+expiry-days [ 28 ] initialize
+
+PRIVATE>
+
+TYPED: valid-date? ( yymmdd: string -- ? )
+    on-or-before-today? [ expiry-days get <= ] [ drop f ] if ;
+
+: valid-stamp? ( stamp -- ? )
+    dup ":" split [ sha1-checksum get-bits ] dip [ 1 3 ] dip subseq first2
+    valid-date? [ string>number head all-char-zero? ] [ 2drop f ] if ;