-USING: help.markup help.syntax kernel math strings ;
+! Copyright (C) 2022 Zoltán Kéri.
+! See http://factorcode.org/license.txt for BSD license.
+USING: hashcash.private help.markup help.syntax kernel math
+random.passwords strings ;
IN: hashcash
ARTICLE: "hashcash" "Hashcash"
-"Hashcash is a denial-of-service counter measure tool."
+"Hashcash is an anti-spam / denial of service counter-measure tool."
$nl
-"A hashcash stamp constitutes a proof-of-work which takes a parameterizable amount of work to compute for the sender. The recipient can verify received hashcash stamps efficiently."
+"A hashcash stamp constitutes a proof-of-work which takes a parameterizable amount of work to compute for the sender. The recipient (and indeed anyone as it is publicly auditable) can verify received hashcash stamps efficiently."
$nl
-"More info on hashcash:"
+"E-mail senders attach hashcash stamps with the " { $snippet X-Hashcash } " header. Vendors and authors of anti-spam tools are encouraged to exempt e-mail sent with hashcash from their blacklists and content-based filtering rules."
$nl
-{ $url "http://www.hashcash.org/" } $nl
-{ $url "http://en.wikipedia.org/wiki/Hashcash" } $nl
-{ $url "http://www.ibm.com/developerworks/linux/library/l-hashcash.html?ca=dgr-lnxw01HashCash" } $nl
-"This library provide basic utilities for hashcash creation and validation."
+"This library provides basic utilities for hashcash creation and validation."
$nl
-"Creating stamps:"
+{ $subheading "Creating stamps" }
{ $subsections
- mint
- mint*
+ mint
+ mint*
}
-"Validation:"
-{ $subsections check-stamp }
-"Hashcash tuple and constructor:"
+{ $subheading "Validation" }
{ $subsections
- hashcash
- <hashcash>
+ valid-stamp?
+ valid-date?
}
-"Utilities:"
-{ $subsections salt } ;
-
-{ mint mint* <hashcash> check-stamp salt } related-words
+{ $subheading "Hashcash tuple and constructor" }
+{ $subsections
+ hashcash
+ <hashcash>
+ expiry-days
+}
+{ $subheading "Private utilities" }
+{ $subsections
+ on-or-before-today?
+ now-gmt-yymmdd
+ yymmdd-gmt-diff
+ yymmdd-gmt>timestamp
+ timestamp>yymmdd
+ lastn-digits
+}
+{ $see-also ascii-password }
+{ $heading "Further readings" }
+{ $url "https://en.wikipedia.org/wiki/Hashcash" } $nl
+{ $url "http://www.hashcash.org/" } $nl
+{ $url "http://www.hashcash.org/papers/hashcash.pdf" } $nl
+{ $url "https://dbpedia.org/page/Hashcash" } $nl
+{ $url "https://nakamoto.com/hashcash/" } ;
HELP: mint
{ $values { "resource" string } { "stamp" "generated stamp" } }
-{ $description "This word generate a valid stamp with default parameters and the specified resource." } ;
+{ $description "This word generates a valid stamp with default parameters and the specified resource." }
+{ $examples
+ { $subheading "Generate a valid stamp" }
+ "The value " { $snippet "foo@bar.com" } " represents the resource string. "
+ "The generated stamp is pushed on the data stack." }
+{ $unchecked-example
+ "USING: hashcash ;"
+ "\"foo@bar.com\" mint"
+ "\n--- Data stack:\n1:20:220401:foo@bar.com::^Xt'xHT;:1eab9d"
+}
+"Generated stamp tabulated for better readability:"
+{ $slots
+ { { $slot "version" } { $snippet "1" } }
+ { { $slot "bits" } { $snippet "20" } }
+ { { $slot "date" } { $snippet "220401" } }
+ { { $slot "resource" } { $snippet "foo@bar.com" } }
+ { { $slot "salt" } { $snippet "^Xt'xHT;:1eab9d" } }
+}
+{ $notes "Examples of common resource strings:"
+ { $list
+ { "IP address" }
+ { "E-mail address" }
+ }
+} ;
HELP: mint*
{ $values { "tuple" "a tuple" } { "stamp" "generated stamp" } }
-{ $description "As " { $snippet "mint" } " but it takes an hashcash tuple as a parameter." } ;
-
-HELP: check-stamp
-{ $values { "stamp" string } { "?" boolean } }
-{ $description "Check for stamp's validity. Only supports hashcash version 1." } ;
+{ $description "As " { $snippet "mint" } " but it takes a hashcash tuple as a parameter." } ;
-HELP: salt
-{ $values { "length" integer } { "salted" string } }
-{ $description "It generates a random string of " { $snippet "length" } " characters." } ;
+HELP: hashcash
+{ $class-description "A hashcash object. A hashcash have the following slots:"
+ { $slots
+ { { $slot "version" } "The version number. Only version 1 is supported." }
+ { { $slot "bits" } "The claimed bit value." }
+ { { $slot "date" } { "The date on which a stamp was minted. Expiry time is 28 days by default. See " { $link valid-stamp? } " for more." } }
+ { { $slot "resource" } "The resource string for which a stamp is minted." }
+ { { $slot "ext" } "Extensions that a specialized application may want. Ignored in version 1 (?)." }
+ { { $slot "salt" } { "A random salt generated with " { $link ascii-password } "." } }
+ { { $slot "suffix" } "The computed suffix. This is supposed to be manipulated by the library." }
+ }
+} ;
HELP: <hashcash>
{ $values { "tuple" object } }
-{ $description "It fill an hashcash tuple with the default values: 1 as hashcash version, 20 as bits, today's date as date and a random 8 character long salt" } ;
+{ $description "It fills a hashcash tuple with the default values: " { $snippet 1 } " as hashcash version, " { $snippet 20 } " as bits, " { $snippet "today's date" } " as date, and a " { $snippet "8-character long random string" } " as salt." } ;
-HELP: hashcash
-{ $class-description "An hashcash object. An hashcash have the following slots:"
- { $slots
- { "version" "The version number. Only version 1 is supported." }
- { "bits" "The claimed bit value." }
- { "date" "The date a stamp was minted." }
- { "resource" "The resource for which a stamp is minted." }
- { "ext" "Extensions that a specialized application may want." }
- { "salt" "A random salt." }
- { "suffix" "The computed suffix. This is supposed to be manipulated by the library." }
- }
+HELP: valid-stamp?
+{ $values { "stamp" string } { "?" boolean } }
+{ $description "Verify the stamp's validity. Only supports hashcash version 1. Expiry time / validity period is 28 days by default as it is the recommended value."
+ $nl
+ "The decision about how long the stamp should be considered valid is up to the verifier. If it is too short, then it is possible for some applications that the stamp will expire before arriving at the recipient (e.g. with e-mail). The suggested value of 28 days should be safe for normal e-mail delivery delays. The choice is a trade-off between database size and risk of expiry prior to arrival, and depends on the application."
+ $nl
+ "Different stamps in the same database can have different validity periods, so for example stamps for different resources with different validity periods can be stored in the same database, or the recipient may change the validity period for future stamps without affecting the validity of old stamps." }
+$nl
+{ "You can obtain the current value by executing the following line of code: " }
+{ $code "expiry-days get" }
+{ "You can modify the expiry time by modifying the value of the symbol " { $snippet "expiry-days" } "." }
+{ $code "32 expiry-days set" }
+{ "This changes the expiry period to 32 days." }
+{ $examples
+ { $example
+ "USING: hashcash ;"
+ "\"foo@bar.com\" mint valid-stamp?"
+ "\n--- Data stack:\nt"
+ }
} ;
-USING: accessors sequences tools.test hashcash ;
+! Copyright (C) 2022 Zoltán Kéri.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors calendar hashcash hashcash.private kernel
+literals namespaces sequences splitting tools.test ;
+IN: hashcash.tests
-{ t } [ "foo@bar.com" mint check-stamp ] unit-test
+! We do not want to generate it multiple times. It would be too slow.
+CONSTANT: generated-mint $[ "foo@bar.com" mint ]
+
+{ t } [ generated-mint dup ":" split third valid-date? swap drop ] unit-test
+
+{ f } [
+ [ -1 expiry-days set
+ generated-mint valid-stamp?
+ ] with-scope
+] unit-test
+
+{ t } [
+ [ 0 expiry-days set
+ generated-mint valid-stamp?
+ ] with-scope
+] unit-test
+
+{ t } [ generated-mint valid-stamp? ] unit-test
{ t } [
- <hashcash>
- "foo@bar.com" >>resource
- 16 >>bits
- mint* check-stamp ] unit-test
+ <hashcash> "foo@bar.com" >>resource 16 >>bits
+ mint* valid-stamp?
+] unit-test
{ t } [
- "1:20:040927:mertz@gnosis.cx::odVZhQMP:7ca28" check-stamp
+ [ 9999 expiry-days set
+ "1:20:220403:foo@bar.com::fAY*-p!s:23472" valid-stamp?
+ ] with-scope
] unit-test
-{ 8 } [ 8 salt length ] unit-test
+{ f } [
+ [ -1 expiry-days set
+ now-gmt-yymmdd valid-date?
+ ] with-scope
+] unit-test
+
+{ t } [
+ [ 0 expiry-days set
+ now-gmt-yymmdd valid-date?
+ ] with-scope
+] unit-test
+
+{ t } [ now-gmt-yymmdd valid-date? ] unit-test
+
+{ 30 } [ "220131" "220101" yymmdd-gmt-diff ] unit-test
+{ -30 } [ "220101" "220131" yymmdd-gmt-diff ] unit-test
+
+{ t } [ now-gmt 1 days time- timestamp>yymmdd on-or-before-today? nip ] unit-test
+{ t } [ now-gmt timestamp>yymmdd on-or-before-today? nip ] unit-test
+{ f } [ now-gmt 1 days time+ timestamp>yymmdd on-or-before-today? nip ] unit-test
! Copyright (C) 2009 Diego Martinelli.
+! Copyright (C) 2022 Zoltán Kéri.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays calendar checksums
-checksums.openssl classes.tuple formatting io.encodings.ascii
-io.encodings.string kernel literals math math.functions
-math.parser ranges present random sequences splitting ;
+USING: accessors byte-arrays calendar calendar.format
+calendar.parser checksums checksums.openssl classes.tuple
+combinators combinators.short-circuit.smart formatting grouping
+io io.encodings.ascii io.encodings.string io.streams.string
+kernel literals make math math.functions math.parser namespaces
+parser present prettyprint quotations random random.passwords
+ranges sequences sequences.deep splitting strings typed words ;
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 "%y%m%d" strftime ;
+: lastn-digits ( n digits -- string )
+ [ number>string ] dip [ 48 pad-head ] keep tail* ;
-! Random salt is formed by ascii characters
-! between 33 and 126
-CONSTANT: available-chars $[
- CHAR: : 33 126 [a..b] remove >byte-array
-]
+: read-yymmdd ( -- y m d )
+ read-00 now start-of-millennium year>> + read-00 read-00 ;
-PRIVATE>
+TYPED: yymmdd-gmt>timestamp ( yymmdd: string -- timestamp )
+ [ read-yymmdd <date-gmt> ] with-string-reader ;
+
+TYPED: timestamp>yymmdd ( timestamp -- yymmdd: string )
+ [ year>> 2 lastn-digits ]
+ [ month>> pad-00 ]
+ [ day>> pad-00 ] tri 3append ;
+
+TYPED: now-gmt-yymmdd ( -- yymmdd: string )
+ now-gmt timestamp>yymmdd ;
-! Generate a 'length' long random salt
-: salt ( length -- salted )
- [ available-chars random ] "" replicate-as ;
+TYPED: yymmdd-gmt-diff ( yymmdd: string yymmdd: string -- days )
+ [ yymmdd-gmt>timestamp ] bi@ time- duration>days ;
+
+TYPED: on-or-before-today? ( yymmdd: string -- x ? )
+ now-gmt-yymmdd swap yymmdd-gmt-diff dup 0 >= ;
+
+PRIVATE>
TUPLE: hashcash version bits date resource ext salt suffix ;
: <hashcash> ( -- tuple )
hashcash new
- 1 >>version
- 20 >>bits
- get-date >>date
- 8 salt >>salt ;
+ 1 >>version
+ 20 >>bits
+ now-gmt-yymmdd >>date
+ 8 ascii-password >>salt ;
M: hashcash string>>
tuple-slots [ present ] map ":" join ;
: mint ( resource -- stamp )
<hashcash>
- swap >>resource
+ swap >>resource
mint* ;
-! One might wanna add check based on the date,
-! passing a 'good-until' duration param
-: check-stamp ( stamp -- ? )
- dup ":" split [ sha1-checksum get-bits ] dip
- second string>number head all-char-zero? ;
+<PRIVATE
+
+! NOTE: Recommended expiry time is 28 days.
+SYMBOL: expiry-days
+expiry-days [ 28 ] initialize
+
+PRIVATE>
+
+TYPED: valid-date? ( yymmdd: string -- ? )
+ on-or-before-today? [ expiry-days get <= ] [ drop f ] if ;
+
+: valid-stamp? ( stamp -- ? )
+ dup ":" split [ sha1-checksum get-bits ] dip [ 1 3 ] dip subseq first2
+ valid-date? [ string>number head all-char-zero? ] [ 2drop f ] if ;
projects / factor.git / commitdiff