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