Paste: Hashcash
Author: | _martind |
Mode: | factor |
Date: | Fri, 8 May 2009 21:39:19 |
Plain Text |
USING: accessors byte-arrays calendar calendar.format
checksums checksums.sha1 classes.tuple fry kernel make math
math.functions math.parser math.ranges present random
sequences strings syntax ;
IN: hashcash
<PRIVATE
: get-date ( -- str )
[ now >date< [ pad-00 dup % ] tri@ ] "" make
[ 3drop ] dip 2 8 rot subseq ;
: available-chars ( -- seq )
33 126 [a,b] [ 1string ] map [ ":" = not ] filter ;
PRIVATE>
: salt ( length -- salted )
'[ _ [ available-chars random % ] times ] "" make ;
TUPLE: hashcash version bits date resource ext salt suffix ;
: <hashcash> ( -- tuple )
hashcash new
1 >>version
16 >>bits
get-date >>date
"" >>ext
8 salt >>salt ;
M: hashcash string>>
tuple-slots [ present ] map ":" join ;
<PRIVATE
: next-suffix ( tuple guess -- tuple )
>hex >>suffix ;
: get-checksum ( tuple -- checksum )
string>> sha1 checksum-bytes hex-string ;
: extract-bits ( checksum tuple -- bits )
bits>> 4 / ceiling 0 spin subseq ;
: is-valid? ( bits -- ? )
[ CHAR: 0 = ] all? ;
: (mint) ( tuple counter -- tuple )
2dup next-suffix get-checksum pick
extract-bits is-valid? [ drop ] [ 1+ (mint) ] if ;
PRIVATE>
: mint* ( tuple -- str )
0 (mint) string>> ;
: mint ( resource -- str )
<hashcash>
swap >>resource
mint* ;
Author: | _martind |
Mode: | factor |
Date: | Fri, 8 May 2009 23:52:52 |
Plain Text |
USING: accessors byte-arrays calendar calendar.format
checksums checksums.openssl classes.tuple fry kernel make math
math.functions math.parser math.ranges present random
sequences strings syntax ;
IN: hashcash
<PRIVATE
: get-date ( -- str )
now [ year>> 100 mod pad-00 ]
[ month>> pad-00 ]
[ day>> pad-00 ]
tri 3append ;
: available-chars ( -- seq )
33 126 [a,b] [ CHAR: : = not ] filter ;
PRIVATE>
: salt ( length -- salted )
available-chars '[ _ random ] "" replicate-as ;
TUPLE: hashcash version bits date resource ext salt suffix ;
: <hashcash> ( -- tuple )
hashcash new
1 >>version
20 >>bits
get-date >>date
8 salt >>salt ;
M: hashcash string>>
tuple-slots [ present ] map ":" join ;
<PRIVATE
: next-suffix ( tuple guess -- tuple )
>hex >>suffix ;
: get-checksum ( tuple -- checksum )
dup string>> openssl-sha1 checksum-bytes
swap bits>> 8 / ceiling head
[ >bin 8 CHAR: 0 pad-head ] { } map-as concat ;
: is-valid? ( checksum tuple -- ? )
bits>> head [ CHAR: 0 = ] all? ;
: (mint) ( tuple counter -- tuple )
2dup next-suffix get-checksum pick
is-valid? [ drop ] [ 1+ (mint) ] if ;
PRIVATE>
: mint* ( tuple -- str )
0 (mint) string>> ;
: mint ( resource -- str )
<hashcash>
swap >>resource
mint* ;
New Annotation