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

;; Issues

(module message-digest-bv

(;export
  ;
  message-digest-update-blob
  message-digest-update-string
  message-digest-blob
  message-digest-string
  message-digest-blob!
  message-digest-string!
  ;DEPRECATED
  message-digest-update-substring)

(import scheme chicken)
(use
  (only srfi-13 substring/shared)
  (only type-checks
    check-blob check-string check-natural-fixnum check-range)
  message-digest-primitive
  message-digest-type
  message-digest-support
  typed-define)

;;; Support

;;

(include "message-digest-types")

;;

(define (check-fixnum-range loc start end)
  ;FIXME chicken does not like dropping a multi-valued result on the floor
  (receive
    (check-range loc
      (check-natural-fixnum loc start 'start)
      (check-natural-fixnum loc end 'end)
      "end < start")) )

;;; Message Digest API

;; Update

;;

;FIXME using & then checking !

(define: (message-digest-update-blob (md message-digest) (blb blob) . (opts list))
  (let-optionals* opts (
    (start 0)
    (end (blob-size (check-blob 'message-digest-update-blob blb))) )
    (check-fixnum-range 'message-digest-update-blob start end)
    (*message-digest-update-blob
      (check-message-digest 'message-digest-update-blob md)
      (blob/slice blb start end)) ) )

;;

(define: (message-digest-update-string (md message-digest) (str string) . (opts list))
  (let-optionals* opts (
    (start 0)
    (end (string-length (check-string 'message-digest-update-string str))) )
    (check-fixnum-range 'message-digest-update-string start end)
    (*message-digest-update-string
      (check-message-digest 'message-digest-update-string md)
      (string/slice str start end)) ) )

;;

;; Single Source API

(define: (message-digest-blob (mdp message-digest-primitive) (blb blob) . (opts list)) --> message-digest-result-type
  (let-optionals* opts (
    (restyp (message-digest-result-form))
    (start 0)
    (end (blob-size (check-blob 'message-digest-blob blb))) )
    (let (
      (md (initialize-message-digest mdp)) )
      (check-fixnum-range 'message-digest-blob start end)
      (message-digest-update-blob md blb start end)
      (finalize-message-digest md restyp) ) ) )

(define: (message-digest-string (mdp message-digest-primitive) (str string) . (opts list)) --> message-digest-result-type
  (let-optionals* opts (
    (restyp (message-digest-result-form))
    (start 0)
    (end (string-length (check-string 'message-digest-string str))) )
    (let (
      (md (initialize-message-digest mdp)) )
      (check-fixnum-range 'message-digest-string start end)
      (message-digest-update-string md str start end)
      (finalize-message-digest md restyp) ) ) )

(define: (message-digest-blob! (mdp message-digest-primitive) (blb blob) (buf message-digest-buffer) . (opts list)) -> message-digest-result-type
  (let-optionals* opts (
    (start 0)
    (end (blob-size (check-blob 'message-digest-blob! blb))) )
    (let (
      (md (initialize-message-digest mdp)) )
      (check-fixnum-range 'message-digest-blob! start end)
      (message-digest-update-blob md blb start end)
      (finalize-message-digest! md buf) ) ) )

(define: (message-digest-string! (mdp message-digest-primitive) (str string) (buf message-digest-buffer) . (opts list)) -> message-digest-result-type
  (let-optionals* opts (
    (start 0)
    (end (string-length (check-string 'message-digest-string! str))) )
    (let (
      (md (initialize-message-digest mdp)) )
      (check-fixnum-range 'message-digest-string! start end)
      (message-digest-update-string md str start end)
      (finalize-message-digest! md buf) ) ) )

;;DEPRECATED

(: message-digest-update-substring deprecated)
(define (message-digest-update-substring md str start end)
  (*message-digest-update-string
    (check-message-digest 'message-digest-update-substring md)
    (substring/shared (check-string 'message-digest-update-substring str) start end)) )

) ;module message-digest-bv