(module (openssl random)
  (
   random-status
   random-poll
   random-add
   random-seed
   random-bytes
   load-random-file
   write-random-file
   random-file-name
   )

(import scheme)
(import (chicken base))
(import (chicken blob))
(import (chicken condition))
(import (chicken foreign))
(import (chicken format))

#>
#include <openssl/err.h>
#include <openssl/rand.h>
<#

(define ERR_clear_error (foreign-lambda void "ERR_clear_error"))
(define ERR_get_error (foreign-lambda unsigned-long "ERR_get_error"))
(define ERR_lib_error_string (foreign-lambda c-string "ERR_lib_error_string" unsigned-long))
(define ERR_func_error_string (foreign-lambda c-string "ERR_func_error_string" unsigned-long))
(define ERR_reason_error_string (foreign-lambda c-string "ERR_reason_error_string" unsigned-long))

(define RAND_status (foreign-lambda bool "RAND_status"))
(define RAND_poll (foreign-lambda bool "RAND_status"))
(define RAND_add (foreign-lambda void "RAND_add" (const blob) int double))
(define RAND_seed (foreign-lambda void "RAND_seed" (const blob) int))
(define RAND_bytes (foreign-lambda int "RAND_bytes" blob int))
(define RAND_load_file (foreign-lambda int "RAND_load_file" c-string long))
(define RAND_write_file (foreign-lambda int "RAND_write_file" c-string))
(define RAND_file_name (foreign-lambda (const c-string) "RAND_file_name" blob size_t))

(define (openssl-error loc #!rest args)
  (let* ((err (ERR_get_error))
         (message (format "error: library=~a, function=~a, reason=~a"
                          (or (ERR_lib_error_string err) "<unknown>")
                          (or (ERR_func_error_string err) "<unknown>")
                          (or (ERR_reason_error_string err) "<unknown>"))))
    (abort
     (condition `(exn message ,message location ,loc arguments ,args)
                '(i/o)
                `(openssl status #f)))))

(define (random-status)
  (RAND_status))

(define (random-poll)
  (RAND_poll))

(define (random-add blob randomness)
  (RAND_add blob (blob-size blob) randomness))

(define (random-seed blob)
  (RAND_seed blob (blob-size blob)))

(define (random-bytes size)
  (ERR_clear_error)
  (let* ((blob (make-blob size))
         (ret (RAND_bytes blob size)))
    (when (not (= ret 1))
      (openssl-error 'random-bytes (list size)))
    blob))

(define (load-random-file path max-bytes)
  (ERR_clear_error)
  (let ((ret (RAND_load_file path max-bytes)))
    (when (= ret -1)
      (openssl-error 'load-random-file (list path max-bytes)))
    ret))

(define (write-random-file path)
  (ERR_clear_error)
  (let ((ret (RAND_write_file path)))
    (when (= ret -1)
      (openssl-error 'write-random-file (list path)))
    ret))

(define (random-file-name)
  (ERR_clear_error)
  (define path-max 256) ; yay NTFS
  (let ((ret (RAND_file_name (make-blob path-max) path-max)))
    (when (not ret)
      (openssl-error 'random-file-name))
    ret))

  )