;;;; message-digest-int.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-int

(;export
  message-digest-update-char-u8
  message-digest-update-char
  message-digest-update-char-be
  message-digest-update-char-le
  message-digest-update-u8
  message-digest-update-u16
  message-digest-update-u16-be
  message-digest-update-u16-le
  message-digest-update-u32
  message-digest-update-u32-be
  message-digest-update-u32-le
  message-digest-update-u64
  message-digest-update-u64-be
  message-digest-update-u64-le)

(import scheme chicken)
(use
  (only type-checks
    check-integer check-char)
  (only type-errors
    error-argument-type)
  message-digest-type
  message-digest-support
  blob-set-int
  typed-define)

;;; Support

;;

(include "message-digest-types")

;;

(define: (get-byte-order (loc symbol) (obj *)) --> message-digest-byte-order
  (case obj
  	((big-endian be big msb)				'big-endian )
  	((little-endian le little lsb)	'little-endian )
    (else
    	(error-argument-type loc obj "symbol in {big-endian little-endian}" obj) ) ) )

;;

(define: (*message-digest-update-uint (loc symbol) (md message-digest) (n number) (size fixnum) (setter procedure))
  (let (
    (blb (setup-message-digest-buffer! (check-message-digest loc md) size)) )
  	(setter blb (check-integer loc n) 0)
  	(*message-digest-update-blob md blb size) ) )

;;; Char & Integer Update

;; Char

(define: (message-digest-update-char-u8 (md message-digest) (ch char))
	(*message-digest-update-uint 'message-digest-update-char-u8
	  md
	  (char->integer (check-char 'message-digest-update-char-u8 ch))
	  1
	  *blob-set-u8!) )

(define: (message-digest-update-char-be (md message-digest) (ch char))
	(*message-digest-update-uint 'message-digest-update-char-be
	  md
	  (char->integer (check-char 'message-digest-update-char ch))
	  4
	  *blob-set-u32-be!) )

(define: (message-digest-update-char-le (md message-digest) (ch char))
	(*message-digest-update-uint 'message-digest-update-char-le
	  md
	  (char->integer (check-char 'message-digest-update-char ch))
	  4
	  *blob-set-u32-le!) )

;; Unsigned Integer 8, 16, 32, & 64 bits

(define: (message-digest-update-u8 (md message-digest) (n number))
	(*message-digest-update-uint 'message-digest-update-u8 md n 1 *blob-set-u8!) )

(define: (message-digest-update-u16-be (md message-digest) (n number))
	(*message-digest-update-uint 'message-digest-update-u16-be md n 2 *blob-set-u16-be!) )

(define: (message-digest-update-u16-le (md message-digest) (n number))
	(*message-digest-update-uint 'message-digest-update-u16-le md n 2 *blob-set-u16-le!) )

(define: (message-digest-update-u32-be (md message-digest) (n number))
	(*message-digest-update-uint 'message-digest-update-u32-be md n 4 *blob-set-u32-be!) )

(define: (message-digest-update-u32-le (md message-digest) (n number))
	(*message-digest-update-uint 'message-digest-update-u32-le md n 4 *blob-set-u32-le!) )

(define: (message-digest-update-u64-be (md message-digest) (n number))
	(*message-digest-update-uint 'message-digest-update-u64-be md n 8 *blob-set-u64-be!) )

(define: (message-digest-update-u64-le (md message-digest) (n number))
	(*message-digest-update-uint 'message-digest-update-u64-le md n 8 *blob-set-u64-le!) )

;; Machine Byte Order w/ Char & Unsigned Integer

(define: (message-digest-update-char (md message-digest) (ch char) . (opts (list message-digest-byte-order)))
  (let (
    (order (optional opts (machine-byte-order))) )
    (case (get-byte-order 'message-digest-update-char order)
      ((little-endian)	(message-digest-update-char-le md ch) )
      ((big-endian)			(message-digest-update-char-be md ch) ) ) ) )

(define: (message-digest-update-u16 (md message-digest) (n number) . (opts (list message-digest-byte-order)))
  (let (
    (order (optional opts (machine-byte-order))) )
    (case (get-byte-order 'message-digest-update-u16 order)
      ((little-endian)	(message-digest-update-u16-le md n) )
      ((big-endian)			(message-digest-update-u16-be md n) ) ) ) )

(define: (message-digest-update-u32 (md message-digest) (n number) . (opts (list message-digest-byte-order)))
  (let (
    (order (optional opts (machine-byte-order))) )
    (case (get-byte-order 'message-digest-update-u32 order)
      ((little-endian)	(message-digest-update-u32-le md n) )
      ((big-endian)			(message-digest-update-u32-be md n) ) ) ) )

(define: (message-digest-update-u64 (md message-digest) (n number) . (opts (list message-digest-byte-order)))
  (let (
    (order (optional opts (machine-byte-order))) )
    (case (get-byte-order 'message-digest-update-u64 order)
      ((little-endian)	(message-digest-update-u64-le md n) )
      ((big-endian)			(message-digest-update-u64-be md n) ) ) ) )

) ;module message-digest-int