;; mzcrypto: crypto library for mzscheme
;; Copyright (C) 2007 Dimitris Vyzovitis <vyzo@media.mit.edu>
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 2.1 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
;; USA

(module util mzscheme
  (require (only (lib "vector-lib.ss" "srfi" "43") vector-index)
           (only (lib "etc.ss") identity))
           
  (provide hex unhex shrink-bytes)

  (define hexes (list->vector (bytes->list #"0123456789abcdef")))
  (define hexes2 (list->vector (bytes->list #"0123456789ABCDEF")))
  (define << arithmetic-shift)
  (define (>> n k) (arithmetic-shift n (- k)))
  (define && bitwise-and)
  (define :: bitwise-ior)
  
  (define (hex bs)
    (let* ((len (bytes-length bs))
           (obs (make-bytes (* 2 len))))
      (do ((i 0 (add1 i))
           (j 0 (+ 2 j)))
          ((= i len) obs)
        (let ((b (bytes-ref bs i)))
          (bytes-set! obs j (vector-ref hexes (>> b 4)))
          (bytes-set! obs (add1 j) (vector-ref hexes (&& b #x0f)))))))

  (define (hex->byte c)
    (cond
     ((vector-index (lambda (x) (eq? x c)) hexes) => identity)
     ((vector-index (lambda (x) (eq? x c)) hexes2) => identity)
     (else (error 'unhex "bad character"))))

  (define (unhex bs)
    (let ((len (bytes-length bs)))
      (unless (even? len)
        (error 'unhex "odd length byte-string"))
      (if (> len 0)
          (let ((obs (make-bytes (/ len 2))))
            (do ((i 0 (+ 2 i))
                 (j 0 (add1 j)))
                ((= i len) obs)
              (bytes-set! obs j (:: (<< (hex->byte (bytes-ref bs i)) 4) 
                                    (hex->byte (bytes-ref bs (add1 i)))))))
          bs)))

  (define (shrink-bytes bs len)
    (if (< len (bytes-length bs))
        (let ((nbs (make-bytes len)))
          (bytes-copy! nbs 0 bs 0 len)
          nbs)
        bs))
)