~ruther/guix-local

6d800a80eaa2a221ee44617fdd702bf7c92f22ed — Ludovic Courtès 13 years ago c8369ca
Add `base16-string->bytevector'.

* guix/utils.scm (base16-string->bytevector): New procedure.

* tests/utils.scm ("bytevector->base16-string->bytevector"): New test.
2 files changed, 35 insertions(+), 0 deletions(-)

M guix/utils.scm
M tests/utils.scm
M guix/utils.scm => guix/utils.scm +28 -0
@@ 35,6 35,7 @@
            bytevector->base16-string
            base32-string->bytevector
            nix-base32-string->bytevector
            base16-string->bytevector
            sha256

            %nixpkgs-directory


@@ 327,6 328,33 @@ starting from the right of S."
          (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.

M tests/utils.scm => tests/utils.scm +7 -0
@@ 62,6 62,13 @@
         ;; 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