1 ! Copyright (C) 2009 Diego Martinelli.
2 ! Copyright (C) 2022 Zoltán Kéri.
3 ! See http://factorcode.org/license.txt for BSD license.
4 USING: accessors byte-arrays calendar calendar.format
5 calendar.parser checksums checksums.openssl classes.tuple
6 combinators combinators.short-circuit.smart formatting grouping
7 io io.encodings.ascii io.encodings.string io.streams.string
8 kernel literals make math math.functions math.parser namespaces
9 parser present prettyprint quotations random random.passwords
10 ranges sequences sequences.deep splitting strings typed words ;
15 : lastn-digits ( n digits -- string )
16 [ number>string ] dip [ 48 pad-head ] keep tail* ;
18 : read-yymmdd ( -- y m d )
19 read-00 now start-of-millennium year>> + read-00 read-00 ;
21 TYPED: yymmdd-gmt>timestamp ( yymmdd: string -- timestamp )
22 [ read-yymmdd <date-gmt> ] with-string-reader ;
24 TYPED: timestamp>yymmdd ( timestamp -- yymmdd: string )
25 [ year>> 2 lastn-digits ]
27 [ day>> pad-00 ] tri 3append ;
29 TYPED: now-gmt-yymmdd ( -- yymmdd: string )
30 now-gmt timestamp>yymmdd ;
32 TYPED: yymmdd-gmt-diff ( yymmdd: string yymmdd: string -- days )
33 [ yymmdd-gmt>timestamp ] bi@ time- duration>days ;
35 TYPED: on-or-before-today? ( yymmdd: string -- x ? )
36 now-gmt-yymmdd swap yymmdd-gmt-diff dup 0 >= ;
40 TUPLE: hashcash version bits date resource ext salt suffix ;
42 : <hashcash> ( -- tuple )
47 8 ascii-password >>salt ;
50 tuple-slots [ present ] map ":" join ;
54 : sha1-checksum ( str -- bytes )
55 ascii encode openssl-sha1 checksum-bytes ; inline
57 : set-suffix ( tuple guess -- tuple )
60 : get-bits ( bytes -- str )
61 [ >bin 8 CHAR: 0 pad-head ] { } map-as concat ;
63 : checksummed-bits ( tuple -- relevant-bits )
64 dup string>> sha1-checksum
65 swap bits>> 8 / ceiling head get-bits ;
67 : all-char-zero? ( seq -- ? )
68 [ CHAR: 0 = ] all? ; inline
70 : valid-guess? ( checksum tuple -- ? )
71 bits>> head all-char-zero? ;
73 : (mint) ( tuple counter -- tuple )
74 2dup set-suffix checksummed-bits pick
75 valid-guess? [ drop ] [ 1 + (mint) ] if ;
79 : mint* ( tuple -- stamp )
82 : mint ( resource -- stamp )
89 ! NOTE: Recommended expiry time is 28 days.
91 expiry-days [ 28 ] initialize
95 TYPED: valid-date? ( yymmdd: string -- ? )
96 on-or-before-today? [ expiry-days get <= ] [ drop f ] if ;
98 : valid-stamp? ( stamp -- ? )
99 dup ":" split [ sha1-checksum get-bits ] dip [ 1 3 ] dip subseq first2
100 valid-date? [ string>number head all-char-zero? ] [ 2drop f ] if ;