1 ! Copyright (C) 2009 Diego Martinelli.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors byte-arrays calendar calendar.format
4 checksums checksums.openssl classes.tuple
5 fry kernel make math math.functions math.parser math.ranges
6 present random sequences splitting strings syntax ;
9 ! Hashcash implementation
10 ! Reference materials listed below:
13 ! http://en.wikipedia.org/wiki/Hashcash
14 ! http://www.ibm.com/developerworks/linux/library/l-hashcash.html?ca=dgr-lnxw01HashCash
16 ! And the reference implementation (in python):
17 ! http://www.gnosis.cx/download/gnosis/util/hashcash.py
21 ! Return a string with today's date in the form YYMMDD
23 now [ year>> 100 mod pad-00 ]
25 [ day>> pad-00 ] tri 3append ;
27 ! Random salt is formed by ascii characters
29 : available-chars ( -- seq )
30 33 126 [a,b] [ CHAR: : = not ] filter ;
34 ! Generate a 'length' long random salt
35 : salt ( length -- salted )
36 available-chars '[ _ random ] "" replicate-as ;
38 TUPLE: hashcash version bits date resource ext salt suffix ;
40 : <hashcash> ( -- tuple )
48 tuple-slots [ present ] map ":" join ;
52 : sha1-checksum ( str -- bytes )
53 openssl-sha1 checksum-bytes ; inline
55 : set-suffix ( tuple guess -- tuple )
58 : get-bits ( bytes -- str )
59 [ >bin 8 CHAR: 0 pad-head ] { } map-as concat ;
61 : checksummed-bits ( tuple -- relevant-bits )
62 dup string>> sha1-checksum
63 swap bits>> 8 / ceiling head get-bits ;
65 : all-char-zero? ( seq -- ? )
66 [ CHAR: 0 = ] all? ; inline
68 : valid-guess? ( checksum tuple -- ? )
69 bits>> head all-char-zero? ;
71 : (mint) ( tuple counter -- tuple )
72 2dup set-suffix checksummed-bits pick
73 valid-guess? [ drop ] [ 1+ (mint) ] if ;
77 : mint* ( tuple -- stamp )
80 : mint ( resource -- stamp )
85 ! One might wanna add check based on the date,
86 ! passing a 'good-until' duration param
87 : check-stamp ( stamp -- ? )
88 dup ":" split [ sha1-checksum get-bits ] dip
89 second string>number head all-char-zero? ;