;;;;message-digest-chunk.scm  -*- Scheme -*-
;;;;Kon Lovett, Jul '18
;;;;Kon Lovett, Aug '17  (message-digest-parameters.scm)

;;Issues
;;
;; - Use "chunk-size".
;;
;; - Uses 'context-info' to determine whether active context is "own" allocation or
;; callers. Again, a kludge.
;;
;; - Passes u8vector to update phase as a blob.
;;
;; - FIXME need chunked memory-mapped stream reader

(module message-digest-chunk

(;export
  ;
  message-digest-raw-chunk
  ;
  message-digest-raw-chunk?
  message-digest-raw-chunk-object
  message-digest-raw-chunk-size
  #; ;UNUSED
  message-digest-raw-chunk-start
  ;
  message-digest-chunk-size
  ;
  message-digest-chunk-port-read-maker
  message-digest-chunk-fileno-read-maker
  ;
  message-digest-chunk-converter)

(import scheme
  (chicken base)
  (chicken type)
  (chicken foreign)
  (only (chicken fixnum) fx< fx<=)
  (only (chicken file posix) file-size port->fileno)
  (only (chicken condition) handle-exceptions)
  (only (srfi 4) u8vector->blob/shared subu8vector read-u8vector! make-u8vector)
  (only type-errors-basic error-argument-type)
  (only miscmacros begin0) )

(define-type call-location (or false symbol string))
(define-type fileno fixnum)

(include-relative "message-digest.types")

(: message-digest-raw-chunk? (* -> boolean : message-digest-raw-chunk))
(: message-digest-raw-chunk-object (message-digest-raw-chunk -> (or false pointer)))
(: message-digest-raw-chunk-size (message-digest-raw-chunk -> (or false fixnum)))
;UNUSED
(: message-digest-raw-chunk-start (message-digest-raw-chunk -> fixnum))

(: message-digest-chunk-size (#!optional fixnum -> fixnum))

;WTF 1 returns chunks & the other blobs, so not interchangeable
(define-type message-digest-chunk-port-reader (input-port #!optional (or false integer) fixnum -> (-> *)))
(define-type message-digest-chunk-fileno-reader (fileno #!optional (or false integer) fixnum -> (-> *)))

(: message-digest-chunk-port-read-maker (#!optional message-digest-chunk-port-reader -> message-digest-chunk-port-reader))
(: message-digest-chunk-fileno-read-maker (#!optional message-digest-chunk-fileno-reader -> message-digest-chunk-fileno-reader))
#|
(: message-digest-chunk-port-read-maker (#!optional integer -> (-> (or false blob))))
(: message-digest-chunk-fileno-read-maker (#!optional integer fixnum -> (-> (or false message-digest-raw-chunk))))
|#

(: message-digest-chunk-converter (#!optional (or false procedure) -> (or false procedure)))

;;

;moremacros
(define-inline (true? x) (and (boolean? x) x))

;fx-inlines
(define-inline (fxpositive? n) (fx< 0 n))
(define-inline (fxnatural? n) (fx<= 0 n))

;;

(: make-message-digest-raw-chunk ((or false pointer) (or false fixnum) fixnum -> message-digest-raw-chunk))

(: default-chunk-port-read-maker (input-port #!optional (or false integer) fixnum -> (-> *)))
(: default-chunk-fileno-read-maker (fileno #!optional (or false integer) fixnum -> (-> (or false message-digest-raw-chunk))))

(: memory-mapped-buffer (call-location fileno (or false integer) (or false fixnum)
                          -> (or false message-digest-raw-chunk) (or false (-> (or false message-digest-raw-chunk))) (-> void)))
(: read-mapped-buffer (call-location fileno (or false integer) (or false fixnum)
                          -> (or false message-digest-raw-chunk) (or false (-> (or false message-digest-raw-chunk))) (-> void)))

;(: mapped-fileno-buffer (call-location fileno fixnum BUFF -> (-> (or false pointer))))

;;; Update Phase Helpers

(define-constant DEFAULT-CHUNK-SIZE 1024)

;NOTE message-digest-raw-chunk -> message-digest-chunk ?

;
(define-record-type message-digest-raw-chunk
  (make-message-digest-raw-chunk obj siz beg)
  message-digest-raw-chunk?
  (obj message-digest-raw-chunk-object message-digest-raw-chunk-object-set!)
  (siz message-digest-raw-chunk-size message-digest-raw-chunk-size-set!)
  ;UNUSED
  (beg message-digest-raw-chunk-start message-digest-raw-chunk-start-set!) )

;FIXME something better for "stream" fd's
(define (file-size* fd) (handle-exceptions exp #f (file-size fd)))
(define (port-file-size* p) (and-let* ((fd (port->fileno p))) (file-size* fd)))

;size input -> maybe non-negative-integer

(define (buffer-byte-size siz chk)
  (let ((unbuffered? (not (and (fixnum? chk) (fxpositive? chk)))))
    (if siz
        ;then size & no buff then all, else min buff or size
        (if unbuffered? siz (min siz chk))
        ;else no size & no buff then byte, else buff
        (if unbuffered? 1 chk)) ) )

(include "message-digest-fsrd-fd-buff.incl")
(cond-expand
  ((or windows unix)
    (include "message-digest-mmap-fd-buff.incl") )
  (else
    (define memory-mapped-buffer read-mapped-buffer) ) )

;NOTE fileno uses chunk since buffer is a foreign-pointer (not allocate/free)
;see message-digest-update-item#*do-bytes-update

;FIXME port should use chunk(?) kinda brittle otherwise

(define (default-chunk-fileno-read-maker fd . opts)
  (let-optionals* opts ((siz (file-size* fd))
                        (chk (message-digest-chunk-size)) )
    ;anything to read?
    (if (and siz (zero? siz))
        ;then always nothing
        (lambda () #f)
        ;else return chunk, after reading, or #f
        ;errors when lolevel problem
        (let*-values (((mapped-buffer)
                        (if siz memory-mapped-buffer read-mapped-buffer))
                      ((chunk next last)
                        (mapped-buffer 'default-chunk-fileno-read-maker fd siz chk)) )
          ;NOTE `chunk' used as a flag
          (define (finishup)
            (set! chunk #f)
            ;NOTE must be idempotent; i.e. `void' when no actual last actions
            (last)
            #f )
          ;no next means 1) chunk already filled, & 2) last read done
          (if next
              ;then use it until done
              (lambda () (and chunk (or (next) (finishup))))
              ;else done already; read-all
              (lambda ()
                (if chunk
                    (begin0 chunk (set! chunk #f))
                    (finishup) ) ) ) ) ) ) )

(define (default-chunk-port-read-maker port . opts)
  (let-optionals* opts ((siz (port-file-size* port))
                        (chk (message-digest-chunk-size)) )
    ;anything to read?
    (if (and siz (zero? siz))
        ;then always nothing
        (lambda () #f)
        ;else return chunk, after reading, or #f
        ;errors when lolevel problem
        (let* ((amt (buffer-byte-size siz chk))
               (u8buf (make-u8vector amt)) )
          (define (u8subbuffer len)
            (let ((u8buf (if (= amt len) u8buf (subu8vector u8buf 0 len))))
              (u8vector->blob/shared u8buf) ) )
          (lambda ()
            (let ((len (read-u8vector! amt u8buf port)))
              (and (positive? len)
                   (u8subbuffer len)) ) ) ) ) ) )

;; Message Digest "chunk"

;;

(define message-digest-chunk-size
  (make-parameter DEFAULT-CHUNK-SIZE
    (lambda (x)
      (if (and (fixnum? x) (fxnatural? x)) x
          (error-argument-type 'message-digest-chunk-size "not a natural fixnum" x) ) ) ) )

(define message-digest-chunk-port-read-maker
  (make-parameter default-chunk-port-read-maker
    (lambda (x)
      (if (procedure? x) x
          (error-argument-type 'message-digest-chunk-port-read-maker "procedure" x) ) ) ) )

(define message-digest-chunk-fileno-read-maker
  (make-parameter default-chunk-fileno-read-maker
    (lambda (x)
      (if (procedure? x) x
          (error-argument-type 'message-digest-chunk-fileno-read-maker "procedure" x) ) ) ) )

(define message-digest-chunk-converter
  (make-parameter #f
    (lambda (x)
      (if (or (not x) (procedure? x)) x
          (error-argument-type 'message-digest-chunk-converter "procedure or #f" x) ) ) ) )

;;;

;FIXME name awful
;(: message-digest-chunk-port-read-maker (deprecated message-digest-chunk-port-reader))
;(: message-digest-chunk-fileno-read-maker (deprecated message-digest-chunk-fileno-reader))

) ;module message-digest-chunk