#lang racket
;
; SHA-2 family of function modelled after openssl/sha1.
;

(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
         (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)))

; vim:set ts=2 sw=2 et: