;;;; entropy-system.scm
;;;; Kon Lovett, Oct '21

(module entropy-system

(;export
  make-entropy-source-system)

(import scheme
  (chicken base)
  (chicken type)
  (only (chicken blob) make-blob)
  (chicken random)
  (only (srfi 4)
    make-f64vector f64vector->blob/shared
    u8vector->blob/shared blob->u8vector/shared)
  entropy-source
  entropy-support)

;;;

;;;

(include "srfi-27-common-types")

(: make-entropy-source-system (-> entropy-source))

;;; Entropy from system

(define-constant EXTERNAL-ID 'system)
(define-constant INTERNAL-ID 'system)

(define f64rand
  (let* (
      (f64blb (f64vector->blob/shared (make-f64vector 1)))
      (u8vec (blob->u8vector/shared f64blb)) )
    (lambda ()
      ;fills in shared blob
      (random-bytes f64blb)
      ;float from shared blob (u8vector)
      (good_positive_double u8vec) ) ) )

(define (make-entropy-source-system)
  (*make-entropy-source
    ;
    make-entropy-source-system
    ;
    EXTERNAL-ID
    ;
    "Entropy from system"
    ;
    (let ((byte (make-blob 1)))
      (lambda ()
        (random-bytes byte) ) )
    ;
    f64rand
    ;
    (lambda (u8cnt u8vec)
      (random-bytes (u8vector->blob/shared u8vec) u8cnt) )
    ;
    (lambda (f64cnt f64vec)
      (entropic-f64vector-filled f64cnt f64vec f64rand) ) ) )

(register-entropy-source! INTERNAL-ID make-entropy-source-system)

) ;module entropy-system