mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -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
|
bytevector->base16-string
|
||||||
base32-string->bytevector
|
base32-string->bytevector
|
||||||
nix-base32-string->bytevector
|
nix-base32-string->bytevector
|
||||||
|
base16-string->bytevector
|
||||||
sha256
|
sha256
|
||||||
|
|
||||||
%nixpkgs-directory
|
%nixpkgs-directory
|
||||||
|
@ -327,6 +328,33 @@ (define chars base16-chars)
|
||||||
(loop (+ 1 i)
|
(loop (+ 1 i)
|
||||||
(cons (vector-ref chars (bytevector-u8-ref bv i)) r))))))
|
(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.
|
;;; Hash.
|
||||||
|
|
|
@ -62,6 +62,13 @@ (define-module (test-utils)
|
||||||
;; Examples from RFC 4648.
|
;; Examples from RFC 4648.
|
||||||
(map string->utf8 '("" "f" "fo" "foo" "foob" "fooba" "foobar"))))
|
(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.
|
;; The following tests requires `nix-hash' in $PATH.
|
||||||
(test-skip (if (false-if-exception (system* "nix-hash" "--version"))
|
(test-skip (if (false-if-exception (system* "nix-hash" "--version"))
|
||||||
0
|
0
|
||||||
|
|
Loading…
Reference in a new issue