Paste: Hashcash

! Copyright (C) 2009 Diego Martinelli.
! See http://factorcode.org/license.txt for BSD license.
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

! 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 >date< [ pad-00 dup % ] tri@ ] "" make 
    [ 3drop ] dip 2 8 rot subseq ;

! Random salt is formed by ascii characters
! between 33 and 126
: available-chars ( -- seq )
    33 126 [a,b] [ 1string ] map [ ":" = not ] filter ;

PRIVATE>

! Generate a 'length' long random salt
: 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* ;

Annotation: a little faster...

! Copyright (C) 2009 Diego Martinelli.
! See http://factorcode.org/license.txt for BSD license.
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

! 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 [ year>> 100 mod pad-00 ] 
        [ month>> pad-00 ] 
        [ day>> pad-00 ]
        tri 3append ;

! Random salt is formed by ascii characters
! between 33 and 126
: available-chars ( -- seq )
    33 126 [a,b] [ CHAR: : = not ] filter ;

PRIVATE>

! Generate a 'length' long random salt
: 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