;;;; sha2.scm

#>
#define SHA2_USE_INTTYPES_H 1
#define SHA2_USE_MEMSET_MEMCPY 1
#define SHA2_LITTLE_ENDIAN 1234
#define SHA2_BIG_ENDIAN    4321
#ifdef C_BIG_ENDIAN
# define SHA2_BYTE_ORDER SHA2_BIG_ENDIAN
#endif
#ifdef C_LITTLE_ENDIAN
# define SHA2_BYTE_ORDER SHA2_LITTLE_ENDIAN
#endif

#include "sha2-base.c"

#undef SHA2_LITTLE_ENDIAN
#undef SHA2_BIG_ENDIAN
#undef SHA2_BYTE_ORDER
#undef SHA2_USE_MEMSET_MEMCPY
#undef SHA2_USE_INTTYPES_H
<#

(module sha2

(;exports
  sha256-primitive sha384-primitive sha512-primitive)

(import scheme
  (chicken base)
  (chicken foreign)
  message-digest-primitive)

;;; 256

(define-foreign-variable context-size-256 int "sizeof(SHA256_CTX)")
(define-foreign-variable digest-length-256 int "SHA256_DIGEST_LENGTH")
(define-foreign-variable block-length-256 int "SHA256_BLOCK_LENGTH")

(define sha256-init (foreign-lambda void "SHA256_Init" c-pointer))
(define sha256-update (foreign-lambda void "SHA256_Update" c-pointer scheme-pointer int))
(define sha256-final (foreign-lambda void "SHA256_Final" c-pointer scheme-pointer))
(define sha256-raw-update (foreign-lambda void "SHA256_Update" c-pointer c-pointer int))

(define sha256-primitive
  (let ((the-sha256-primitive #f))
    (lambda ()
      (unless the-sha256-primitive
        (set! the-sha256-primitive
              (make-message-digest-primitive
                context-size-256 digest-length-256 sha256-init sha256-update sha256-final
                #:block-length block-length-256 #:raw-update sha256-raw-update #:name 'sha256)) )
      the-sha256-primitive ) ) )

;;; 384

(define-foreign-variable context-size-384 int "sizeof(SHA384_CTX)")
(define-foreign-variable digest-length-384 int "SHA384_DIGEST_LENGTH")
(define-foreign-variable block-length-384 int "SHA384_BLOCK_LENGTH")

(define sha384-init (foreign-lambda void "SHA384_Init" c-pointer))
(define sha384-update (foreign-lambda void "SHA384_Update" c-pointer scheme-pointer int))
(define sha384-final (foreign-lambda void "SHA384_Final" c-pointer scheme-pointer))
(define sha384-raw-update (foreign-lambda void "SHA384_Update" c-pointer c-pointer int))

(define sha384-primitive
  (let ((the-sha384-primitive #f))
    (lambda ()
      (unless the-sha384-primitive
        (set! the-sha384-primitive
              (make-message-digest-primitive
                context-size-384 digest-length-384 sha384-init sha384-update sha384-final
                #:block-length block-length-384 #:raw-update sha384-raw-update #:name 'sha384)) )
      the-sha384-primitive ) ) )

;;; 512

(define-foreign-variable context-size-512 int "sizeof(SHA512_CTX)")
(define-foreign-variable digest-length-512 int "SHA512_DIGEST_LENGTH")
(define-foreign-variable block-length-512 int "SHA512_BLOCK_LENGTH")

(define sha512-init (foreign-lambda void "SHA512_Init" c-pointer))
(define sha512-update (foreign-lambda void "SHA512_Update" c-pointer scheme-pointer int))
(define sha512-final (foreign-lambda void "SHA512_Final" c-pointer scheme-pointer))
(define sha512-raw-update (foreign-lambda void "SHA512_Update" c-pointer c-pointer int))

(define sha512-primitive
  (let ((the-sha512-primitive #f))
    (lambda ()
      (unless the-sha512-primitive
        (set! the-sha512-primitive
              (make-message-digest-primitive
                context-size-512 digest-length-512 sha512-init sha512-update sha512-final
                #:block-length block-length-512 #:raw-update sha512-raw-update #:name 'sha512)) )
      the-sha512-primitive ) ) )

) ;module sha2