aboutsummaryrefslogtreecommitdiff
path: root/module/crypto.scm
blob: 79eaaf89cddae889ac7fe6681bdbdffa11d0beb4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
(define-module (crypto)
  :use-module (rnrs bytevectors)
  :use-module (system foreign)
  :use-module (ice-9 format)
  :export (sha256 checksum->string))

(define-once libcrypto (dynamic-link "libcrypto"))

(define SHA_DIGEST_LENGTH       20)
(define SHA224_DIGEST_LENGTH    28)
(define SHA256_DIGEST_LENGTH    32)
(define SHA384_DIGEST_LENGTH    48)
(define SHA512_DIGEST_LENGTH    64)

(define SHA256
 ((@ (system foreign) pointer->procedure)
  '* (dynamic-func "SHA256" libcrypto)
  `(* ,(@ (system foreign) size_t) *)))

(define (sha256 msg)
  (define md (make-bytevector SHA256_DIGEST_LENGTH))
  (define bv
    (cond ((bytevector? msg) msg)
          ((string? msg) (string->utf8 msg))
          (else (throw 'value-error "Invalid type"))))
  (SHA256 ((@ (system foreign) bytevector->pointer) bv)
          (bytevector-length bv)
          ((@ (system foreign) bytevector->pointer) md))
  md)

(define* (checksum->string md #:optional port)
  ((@ (ice-9 format) format) port
   "~{~2'0x~}" (bytevector->u8-list md)))