;;;; message-digest-utils-test.scm  -*- Scheme -*-
;;;; Kon Lovett, Jul '18

;; Issues
;;
;; - Needs many more tests, especially the entire input-port & procedure source stuff.

(import test)

(test-begin "Message Digest Utils")

;;;

(import
  (chicken base)
  ;(chicken format)
  (chicken fixnum)
  (chicken blob)
  (chicken memory)
  (srfi 4)
  message-digest-primitive
  message-digest-type
  message-digest-chunk
  message-digest-port
  message-digest-srfi-4
  message-digest-int
  message-digest-update-item
  message-digest-item)

;;

(define (ashexstr s)
	(apply string-append
		(map
			(lambda (c) (number->string (char->integer c) 16))
			(string->list s))) )

(define simple-src "ab cd")
(define simple-res (ashexstr simple-src))

(define-constant DIGEST-LENGTH 5)
(define-constant CONTEXT-SIZE 10)
(define-constant BLOCK-LENGTH 64)

(define-constant BLOCK-LENGTH-DEFAULT 4)

(define SHORT-TEST-FILE-NAME "alpha.txt")
(define SHORT-TEST-FILE-LENGTH 26)

(define just-once
  (let ((x #t))
    (lambda ()
      (let (
        (res (and x simple-src)) )
        (set! x #f)
        res ) ) ) )

;FIXME add (mock-*-primitive ...) that wraps the supplied phase procedures

;;

(test 'hex-string (message-digest-result-form 'hex))

;Tests defaults
(test-group "Chunk Read (port)"
  (let (
    (siz (message-digest-chunk-size))
    (in (open-input-file SHORT-TEST-FILE-NAME)) )
    (let* (
      (rdr ((message-digest-chunk-port-read-maker) in))
      (res (rdr)) )
      (test-assert "First chunk type" (blob? res))
      (test "First chunk size" SHORT-TEST-FILE-LENGTH (blob-size res))
      (test-assert "No more chunk" (not (rdr))) )
    (close-input-port in) )
)

(let ()

	(define the-ctx #f)

  (define (make-context)
    ;Init to 0 necessary since DIGEST-LENGTH is possibly > than
    ;the input size! (Actually just needs to be a known value,
    ;`(integer->char #xff)' would work as well.)
    (string->blob (make-string CONTEXT-SIZE #\nul)) )

  (define (init ctx)
    (set! the-ctx ctx) )

  (define (update ctx bytes count)
    ;(printf "Update Ctx: ~S Bytes: ~S Count: ~S~%" ctx bytes count) (flush-output)
    (assert (eq? ctx the-ctx))
    (assert (not (not bytes)))
    (assert (< 0 count))
    (assert (<= count CONTEXT-SIZE))  ; So no mem overflow
    (assert (blob? ctx))
    (move-memory! bytes ctx count) )

  (define (final ctx result)
    ;(printf "Final Result Size: ~S Ctx: ~S Result: ~S~%" (blob-size result) ctx result) (flush-output)
    (assert (eq? ctx the-ctx))
    (assert (not (not result)))
    (assert (blob? ctx))
    (assert (<= (blob-size result) DIGEST-LENGTH))  ; So no mem overflow
    (move-memory! ctx result DIGEST-LENGTH) )

  (define mdp (make-message-digest-primitive make-context DIGEST-LENGTH init update final))

  (test-group "u8vector Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-u8vector md (u8vector 1 2 3 4 5)))
      (test "0102030405" (finalize-message-digest md)) )
  )

  (test-group "u8 Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-u8 md #xA2))
      (test "a200000000" (finalize-message-digest md)) )
  )

  (test-group "u16-le Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-u16-le md #xA2B2))
      (test "b2a2000000" (finalize-message-digest md)) )
  )

  (test-group "u32-be Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-u32-be md 1073741823))
      (test "3fffffff00" (finalize-message-digest md)) )
  )

  (test-group "u32-be Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-u32-be md #xA2B2C2D2))
      (test "a2b2c2d200" (finalize-message-digest md)) )
  )

  (test-group "u64-be Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-u64-be md #xAB54A98CEB1F0AD2))
      (test
        (substring "ab54a98ceb1f0ad2" 0 (fx* 2 (fxmin 8 DIGEST-LENGTH)))
        (finalize-message-digest md)) )
  )

  (test-group "char-u8 Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-char-u8 md #\space))
      (test "2000000000" (finalize-message-digest md)) )
  )

  (test-group "char-be Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-char-be md #\u0003BB))
      (test "000003bb00" (finalize-message-digest md)) )
  )

  (test-group "char-le Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-char-le md #\u0003BB))
      (test "bb03000000" (finalize-message-digest md)) )
  )

  (test-group "Procedure Source"
    (let (
      (md (initialize-message-digest mdp)) )
      (test-assert (message-digest-update-procedure md just-once))
      (test simple-res (finalize-message-digest md)) )
  )

  (test-group "Port"
    (let (
      (port (open-output-digest mdp)) )
      (test-assert (output-port? port))
      (display simple-src port) ;cannot be readable!
      (test simple-res (get-output-digest port))
      (test-assert (port-closed? port)) )
  )
)

;
(test-group "Chunk Read (fileno)"

	(define the-ctx #f)

  (define (init ctx)
    ;(printf "  Init Ctx: ~S~%" ctx)
    (assert (pointer? ctx))
    (set! the-ctx ctx) )

  (define (update ctx bytes count)
  	;(printf "Update Ctx: ~S Count: ~S Bytes: ~S~%" ctx count bytes)
    (assert (eq? ctx the-ctx))
    (assert (not (not bytes)))
    (assert (< 0 count))
    (assert (<= count CONTEXT-SIZE))
    (assert (pointer? ctx))
    (move-memory! bytes ctx count) )

  (define (raw-update ctx bytes count)
  	;(printf "Raw-Update Ctx: ~S Count: ~S Bytes: ~S~%" ctx count bytes)
    (assert (eq? ctx the-ctx))
    (assert (not (not bytes)))
    (assert (< 0 count))
    (assert (= SHORT-TEST-FILE-LENGTH count))
    (assert (pointer? ctx))
    (move-memory! bytes ctx (min CONTEXT-SIZE count)) )

  (define (final ctx result)
    ;(printf " Final Ctx: ~S Length: ~S Result: ~S~%" ctx DIGEST-LENGTH result)
    (assert (eq? ctx the-ctx))
    (assert (not (not result)))
    (assert (pointer? ctx))
    ;(assert (<= 0 DIGEST-LENGTH))
    (move-memory! ctx result DIGEST-LENGTH) )

  (let (
    (mdp
      (make-message-digest-primitive CONTEXT-SIZE DIGEST-LENGTH init update final #:raw-update raw-update)) )
    (test "6162636465" (message-digest-file mdp SHORT-TEST-FILE-NAME 'hex-string)) )
)

;;;

(test-end "Message Digest Utils")

(test-exit)