;;;; message-digest-srfi-4.scm
;;;; Kon Lovett, Jan '06 (message-digest.scm)
;;;; Kon Lovett, May '10 (message-digest.scm)
;;;; Kon Lovett, Apr '12
;;;; Kon Lovett, Aug '17

;; Issues
;;
;; - Passes u8vector to update phase as a blob.

(module message-digest-srfi-4

(;export
  message-digest-update-u8vector
  message-digest-update-packed-vector
  message-digest-u8vector message-digest-u8vector!
  ;DEPRECATED
  message-digest-update-bytevector
  message-digest-update-subu8vector
  )

(import scheme chicken)
(use
  data-structures
  srfi-4
  (only lolevel number-of-bytes)
  (only srfi-4-checks check-u8vector)
  (only type-errors error-argument-type)
  message-digest-primitive
  message-digest-type
  message-digest-support
  message-digest-bv
  typed-define)

;;; Support

;;

(include "message-digest-types")

;;

(define: (get-bytevector-object (loc symbol) (obj *)) --> blob
	(cond
		((string? obj)
		  (string->blob obj) )
		((blob? obj)
		  obj )
		((packed-vector->blob/shared obj) )
		(else
    	(error-argument-type loc obj "string, blob, or SRFI 4 vector" obj) ) ) )

;;; Update API

;;

(define: (message-digest-update-u8vector (md message-digest) (u8vec u8vector) . (opts list))
  (let-optionals* opts (
    (start 0)
    (end (u8vector-length u8vec)) )
    (message-digest-update-blob md
      (u8vector->blob/shared (u8vector/slice u8vec start end))) ) )

;;; Single Source API

(define: (message-digest-u8vector (mdp message-digest-primitive) (u8vec u8vector) . (opts list)) --> message-digest-result-type
  (let-optionals* opts (
    (restyp (message-digest-result-form))
    (start 0)
    (end (u8vector-length u8vec)) )
    (let ((md (initialize-message-digest mdp)))
      (message-digest-update-u8vector md u8vec start end)
      (finalize-message-digest md restyp) ) ) )

(define: (message-digest-u8vector! (mdp message-digest-primitive) (u8vec u8vector) (buffer message-digest-buffer) . (opts list)) -> message-digest-result-type
  (let-optionals* opts (
    (start 0)
    (end (u8vector-length u8vec)) )
    (let ((md (initialize-message-digest mdp)))
      (message-digest-update-u8vector md u8vec start end)
      (finalize-message-digest! md buffer) ) ) )

;;DEPRECATED

(: message-digest-update-subu8vector deprecated)
(define (message-digest-update-subu8vector md u8vec start end)
  (message-digest-update-blob md (u8vector->blob/shared (subu8vector u8vec start end))) )

(: message-digest-update-packed-vector deprecated)
(define (message-digest-update-packed-vector md pkdvec)
  (let (
    (blb (packed-vector->blob/shared pkdvec)) )
    (if blb
      (message-digest-update-blob md blb)
      (error-argument-type 'message-digest-update-packed-vector pkdvec "SRFI 4 vector") ) ) )

(: message-digest-update-bytevector deprecated)
(define (message-digest-update-bytevector md bv #!optional (len (number-of-bytes bv)))
  (check-message-digest 'message-digest-update-bytevector md)
  (let (
    (mdp (message-digest-algorithm md))
    (ctx (message-digest-context md)) )
    ((message-digest-primitive-update mdp)
    	ctx
    	(get-bytevector-object 'message-digest-update-bytevector bv)
    	len) ) )

) ;module message-digest-srfi-4