mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
Add `base16-string->bytevector'.
* guix/utils.scm (base16-string->bytevector): New procedure. * tests/utils.scm ("bytevector->base16-string->bytevector"): New test.
This commit is contained in:
parent
c8369cacce
commit
6d800a80ea
2 changed files with 35 additions and 0 deletions
|
@ -35,6 +35,7 @@ (define-module (guix utils)
|
|||
bytevector->base16-string
|
||||
base32-string->bytevector
|
||||
nix-base32-string->bytevector
|
||||
base16-string->bytevector
|
||||
sha256
|
||||
|
||||
%nixpkgs-directory
|
||||
|
@ -327,6 +328,33 @@ (define chars base16-chars)
|
|||
(loop (+ 1 i)
|
||||
(cons (vector-ref chars (bytevector-u8-ref bv i)) r))))))
|
||||
|
||||
(define base16-string->bytevector
|
||||
(let ((chars->value (fold (lambda (i r)
|
||||
(vhash-consv (string-ref (number->string i 16)
|
||||
0)
|
||||
i r))
|
||||
vlist-null
|
||||
(iota 16))))
|
||||
(lambda (s)
|
||||
"Return the bytevector whose hexadecimal representation is string S."
|
||||
(define bv
|
||||
(make-bytevector (quotient (string-length s) 2) 0))
|
||||
|
||||
(string-fold (lambda (chr i)
|
||||
(let ((j (quotient i 2))
|
||||
(v (and=> (vhash-assv chr chars->value) cdr)))
|
||||
(if v
|
||||
(if (zero? (logand i 1))
|
||||
(bytevector-u8-set! bv j
|
||||
(arithmetic-shift v 4))
|
||||
(let ((w (bytevector-u8-ref bv j)))
|
||||
(bytevector-u8-set! bv j (logior v w))))
|
||||
(error "invalid hexadecimal character" chr)))
|
||||
(+ i 1))
|
||||
0
|
||||
s)
|
||||
bv)))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Hash.
|
||||
|
|
|
@ -62,6 +62,13 @@ (define-module (test-utils)
|
|||
;; Examples from RFC 4648.
|
||||
(map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
|
||||
|
||||
(test-assert "bytevector->base16-string->bytevector"
|
||||
(every (lambda (bv)
|
||||
(equal? (base16-string->bytevector
|
||||
(bytevector->base16-string bv))
|
||||
bv))
|
||||
(map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
|
||||
|
||||
;; The following tests requires `nix-hash' in $PATH.
|
||||
(test-skip (if (false-if-exception (system* "nix-hash" "--version"))
|
||||
0
|
||||
|
|
Loading…
Reference in a new issue