;;;; message-digest-byte-vector.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18
;;;; Kon Lovett, Aug '17
;;;; Kon Lovett, Apr '12
;;;; Kon Lovett, May '10 (message-digest.scm)
;;;; Kon Lovett, Jan '06 (message-digest.scm)

(module message-digest-byte-vector

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

(import scheme
  (chicken base)
  (chicken blob)
  (chicken type)
  (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)

;;; 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 !

(: message-digest-update-blob (message-digest blob #!rest -> void))
;
(define (message-digest-update-blob md blb . opts)
  (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)) ) )

;;

(: message-digest-update-string (message-digest string #!rest -> void))
;
(define (message-digest-update-string md str . opts)
  (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

(: message-digest-blob (message-digest-primitive blob #!rest -> message-digest-result-type))
;
(define (message-digest-blob mdp blb . opts)
  (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) ) ) )

(: message-digest-string (message-digest-primitive string #!rest -> message-digest-result-type))
;
(define (message-digest-string mdp str . opts)
  (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) ) ) )

(: message-digest-blob! (message-digest-primitive blob message-digest-buffer #!rest -> message-digest-result-type))
;
(define (message-digest-blob! mdp blb buf . opts)
  (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) ) ) )

(: message-digest-string! (message-digest-primitive string message-digest-buffer #!rest -> message-digest-result-type))
;
(define (message-digest-string! mdp str buf . opts)
  (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) ) ) )

) ;module message-digest-byte-vector