extra/hashcash/hashcash.factor

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