+(define-syntax-rule (define-compile-time-decoder name string->bytevector)
+ "Define NAME as a macro that runs STRING->BYTEVECTOR at macro expansion time
+if possible."
+ (define-syntax name
+ (lambda (s)
+ "Return the bytevector corresponding to the given textual
+representation."
+ (syntax-case s ()
+ ((_ str)
+ (string? (syntax->datum #'str))
+ ;; A literal string: do the conversion at expansion time.
+ (with-syntax ((bv (string->bytevector (syntax->datum #'str))))
+ #''bv))
+ ((_ str)
+ #'(string->bytevector str))))))
+
+(define-compile-time-decoder base32 nix-base32-string->bytevector)
+(define-compile-time-decoder base64 base64-decode)
+
+;; Crytographic content hash.
+(define-immutable-record-type <content-hash>
+ (%content-hash algorithm value)
+ content-hash?
+ (algorithm content-hash-algorithm) ;symbol
+ (value content-hash-value)) ;bytevector
+
+(define-syntax-rule (define-content-hash-constructor name
+ (algorithm size) ...)
+ "Define NAME as a <content-hash> constructor that ensures that (1) its
+second argument is among the listed ALGORITHM, and (2), when possible, that
+its first argument has the right size for the chosen algorithm."
+ (define-syntax name
+ (lambda (s)
+ (syntax-case s (algorithm ...)
+ ((_ bv algorithm)
+ (let ((bv* (syntax->datum #'bv)))
+ (when (and (bytevector? bv*)
+ (not (= size (bytevector-length bv*))))
+ (syntax-violation 'content-hash "invalid content hash length" s))
+ #'(%content-hash 'algorithm bv)))
+ ...))))
+
+(define-content-hash-constructor build-content-hash
+ (sha256 32)
+ (sha512 64)
+ (sha3-256 32)
+ (sha3-512 64)
+ (blake2s-256 64))
+
+(define-syntax content-hash
+ (lambda (s)
+ "Return a content hash with the given parameters. The default hash
+algorithm is sha256. If the first argument is a literal string, it is decoded
+as base32. Otherwise, it must be a bytevector."
+ ;; What we'd really want here is something like C++ 'constexpr'.
+ (syntax-case s ()
+ ((_ str)
+ (string? (syntax->datum #'str))
+ #'(content-hash str sha256))
+ ((_ str algorithm)
+ (string? (syntax->datum #'str))
+ (with-syntax ((bv (base32 (syntax->datum #'str))))
+ #'(content-hash bv algorithm)))
+ ((_ (id str) algorithm)
+ (and (string? (syntax->datum #'str))
+ (free-identifier=? #'id #'base32))
+ (with-syntax ((bv (nix-base32-string->bytevector (syntax->datum #'str))))
+ #'(content-hash bv algorithm)))
+ ((_ (id str) algorithm)
+ (and (string? (syntax->datum #'str))
+ (free-identifier=? #'id #'base64))
+ (with-syntax ((bv (base64-decode (syntax->datum #'str))))
+ #'(content-hash bv algorithm)))
+ ((_ bv)
+ #'(content-hash bv sha256))
+ ((_ bv hash)
+ #'(build-content-hash bv hash)))))
+
+(define (print-content-hash hash port)
+ (format port "#<content-hash ~a:~a>"
+ (content-hash-algorithm hash)
+ (and=> (content-hash-value hash)
+ bytevector->nix-base32-string)))
+
+(set-record-type-printer! <content-hash> print-content-hash)
+
+\f