(import (scheme)
        (chicken base)
        (chicken foreign)
        (chicken gc)
        (chicken io)
        (chicken locative)
        (chicken memory)
        srfi-4
        srfi-207)

(foreign-declare "#include \"bearssl.h\"")
;; ^ includes all bearssl headers

(define-foreign-type sha1-context
  (c-pointer "br_sha1_context"))

(define (allocate-sha1-context)
  (allocate (foreign-type-size "br_sha1_context")))

(define (free-sha1-context ctx)
  (free ctx))

(define (make-sha1-context)
  (let ((ctx (allocate-sha1-context)))
    (set-finalizer! ctx free-sha1-context)
    ctx))

(define sha1-init
  (foreign-lambda
   void "br_sha1_init" sha1-context))

(define sha1-update
  (foreign-lambda
   void "br_sha1_update" sha1-context (const (scheme-pointer void)) size_t))

(define sha1-out
  (foreign-lambda
   void "br_sha1_out" (const sha1-context) (scheme-pointer void)))

(define sha1-state
  (foreign-lambda
   unsigned-integer64 "br_sha1_state" (const sha1-context) (scheme-pointer void)))

(define sha1-set-state
  (foreign-lambda
   void "br_sha1_set_state" sha1-context (const (scheme-pointer void)) unsigned-integer64))

(let* ((ctx (make-sha1-context))
       (len 4096)
       (buf (make-u8vector len))
       (res (make-u8vector 20))
       (b-buf (u8vector->blob/shared buf))
       (b-res (u8vector->blob/shared res)))
  ;; init
  (sha1-init ctx)
  ;; update
  (let loop ()
    (let ((n (read-u8vector! len buf)))
      (when (> n 0)
        (sha1-update ctx b-buf n)
        (loop))))
  ;; result
  (sha1-out ctx b-res)
  (print (bytevector->hex-string res)))