#lang racket
(require (rename-in ffi/unsafe (-> ffi->))
(prefix-in r: file/sha1)
openssl/libcrypto)
(provide sha224
sha224-bytes
sha256
sha256-bytes
sha512
sha512-bytes
bytes->sha224
bytes->sha256
bytes->sha512
string->sha224/utf-8
string->sha256/utf-8
string->sha512/utf-8
(rename-out [r:bytes->hex-string bytes->hex-string]))
(define _SHA224_CTX-pointer _pointer)
(define _SHA256_CTX-pointer _pointer)
(define _SHA512_CTX-pointer _pointer)
(define (init-fn name ctx-type)
(and libcrypto
(get-ffi-obj name libcrypto
(_fun ctx-type ffi-> _int)
(lambda () #f))))
(define (update-fn name ctx-type)
(and libcrypto
(get-ffi-obj name libcrypto
(_fun ctx-type _pointer _long ffi-> _int)
(lambda () #f))))
(define (final-fn name ctx-type)
(and libcrypto
(get-ffi-obj name libcrypto
(_fun _pointer ctx-type ffi-> _int)
(lambda () #f))))
(define SHA224_Init (init-fn 'SHA224_Init _SHA224_CTX-pointer))
(define SHA224_Update (update-fn 'SHA224_Update _SHA224_CTX-pointer))
(define SHA224_Final (final-fn 'SHA224_Final _SHA224_CTX-pointer))
(define SHA256_Init (init-fn 'SHA256_Init _SHA256_CTX-pointer))
(define SHA256_Update (update-fn 'SHA256_Update _SHA256_CTX-pointer))
(define SHA256_Final (final-fn 'SHA256_Final _SHA256_CTX-pointer))
(define SHA512_Init (init-fn 'SHA512_Init _SHA512_CTX-pointer))
(define SHA512_Update (update-fn 'SHA512_Update _SHA512_CTX-pointer))
(define SHA512_Final (final-fn 'SHA512_Final _SHA512_CTX-pointer))
(define (make-sha-fn result-len init update final)
(lambda (in)
(let ([ctx (malloc 256)]
[tmp (make-bytes 4096)]
[result (make-bytes result-len)])
(init ctx)
(let loop ()
(let ([n (read-bytes-avail! tmp in)])
(unless (eof-object? n)
(update ctx tmp n)
(loop))))
(final result ctx)
result)))
(define sha224-bytes-fn
(make-sha-fn (/ 224 8) SHA224_Init SHA224_Update SHA224_Final))
(define sha256-bytes-fn
(make-sha-fn (/ 256 8) SHA256_Init SHA256_Update SHA256_Final))
(define sha512-bytes-fn
(make-sha-fn (/ 512 8) SHA512_Init SHA512_Update SHA512_Final))
(define/contract (sha224-bytes in)
(-> input-port? bytes?)
(sha224-bytes-fn in))
(define/contract (sha256-bytes in)
(-> input-port? bytes?)
(sha256-bytes-fn in))
(define/contract (sha512-bytes in)
(-> input-port? bytes?)
(sha512-bytes-fn in))
(define/contract (sha224 in)
(-> input-port? string?)
(r:bytes->hex-string (sha224-bytes in)))
(define/contract (sha256 in)
(-> input-port? string?)
(r:bytes->hex-string (sha256-bytes in)))
(define/contract (sha512 in)
(-> input-port? string?)
(r:bytes->hex-string (sha512-bytes in)))
(define/contract (bytes->sha224 bstr)
(-> bytes? string?)
(let ((port (open-input-bytes bstr)))
(sha224 port)))
(define/contract (bytes->sha256 bstr)
(-> bytes? string?)
(let ((port (open-input-bytes bstr)))
(sha256 port)))
(define/contract (bytes->sha512 bstr)
(-> bytes? string?)
(let ((port (open-input-bytes bstr)))
(sha512 port)))
(define/contract (string->sha224/utf-8 str)
(-> string? string?)
(bytes->sha224 (string->bytes/utf-8 str)))
(define/contract (string->sha256/utf-8 str)
(-> string? string?)
(bytes->sha256 (string->bytes/utf-8 str)))
(define/contract (string->sha512/utf-8 str)
(-> string? string?)
(bytes->sha512 (string->bytes/utf-8 str)))