Initial commit

core/src/lib/hash.scm

@@ -0,0 +1,41 @@
+(define-library (zilch lib hash)
+ (import
+   (scheme base) (scheme write)
+   (chicken foreign)
+   (srfi 151))
+ (export sha256 hex)
+
+ (begin
+   (foreign-declare "#include <sodium/crypto_hash_sha256.h>")
+  
+   (define sodium-sha256 (foreign-lambda void "crypto_hash_sha256" nonnull-u8vector nonnull-u8vector unsigned-integer64))
+   (define sodium-sha256-init (foreign-lambda void "crypto_hash_sha256_init" (nonnull-scheme-pointer "crypto_hash_sha256_state")))
+   (define sodium-sha256-update (foreign-lambda void "crypto_hash_sha256_update" (nonnull-scheme-pointer "crypto_hash_sha256_state") nonnull-u8vector unsigned-integer64))
+   (define sodium-sha256-final (foreign-lambda void "crypto_hash_sha256_final" (nonnull-scheme-pointer "crypto_hash_sha256_state") nonnull-u8vector))
+
+   (define (sha256 buf)
+     (define out (make-bytevector 32))
+     (cond
+       ((bytevector? buf) (sodium-sha256 out buf (bytevector-length buf)))
+       ((string? buf) (set! buf (string->utf8 buf)) (sodium-sha256 out buf (bytevector-length buf)))
+       ((input-port? buf)
+        (let
+          ((state (make-bytevector (foreign-type-size "crypto_hash_sha256_state") 0))
+           (bbuf (make-bytevector 32 0)))
+          (sodium-sha256-init state)
+          (do
+           ((bytes-read 0 (read-bytevector! bbuf buf)))
+           ((eof-object? bytes-read) (sodium-sha256-final state out))
+           (sodium-sha256-update state bbuf bytes-read))))
+       (else (error "unknown object type passed to ((zilch lib hash) sha256)")))
+    out)
+  
+   (define hexit "0123456789abcdef")
+
+   (define (hex bv)
+     (define out (make-string (* (bytevector-length bv) 2) #\!))
+     (do ((i 0 (+ i 1)))
+         ((>= i (bytevector-length bv)) out)
+       (let* ((val (bytevector-u8-ref bv i)) (q (arithmetic-shift val -4)) (r (bitwise-and val #xF)))
+         (string-set! out (* i 2) (string-ref hexit q))
+         (string-set! out (+ (* i 2) 1) (string-ref hexit r)))))))