;;; Chickadee Game Toolkit
;;; Copyright © 2023 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(define-module (chickadee base64)
  #:use-module (rnrs bytevectors)
  #:export (base64-decode))

(define %base64-chars
  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")

(define %decode-table
  (let ((table (make-hash-table)))
    (let loop ((i 0))
      (when (< i 64)
        (hashv-set! table (string-ref %base64-chars i) i)
        (loop (+ i 1))))
    (hashv-set! table #\= 0)
    table))

(define (base64-decode str)
  "Decode the base64 encoded string STR and return a bytevector
containing the decoded data."
  (let* ((n (string-length str))
         (groups (/ n 4)))
    (define (padding? i)
      (eqv? (string-ref str i) #\=))
    (define (decode i)
      (let ((c (string-ref str i)))
        (or (hashv-ref %decode-table c)
            (error 'base64-error "invalid base64 character" c))))
    (define (decode4 group)
      (let ((start (* group 4)))
        (logior (ash (decode start) 18)
                (ash (decode (+ start 1)) 12)
                (ash (decode (+ start 2)) 6)
                (decode (+ start 3)))))
    (unless (exact-integer? groups)
      (error 'base64-error "invalid character count"))
    (let* ((padding (cond
                     ((and (padding? (- n 2)) (padding? (- n 1))) 2)
                     ((padding? (- n 1)) 1)
                     (else 0)))
           (bv (make-bytevector (- (* groups 3) padding))))
      (let loop ((i 0))
        (cond
         ((= i (- groups 1))
          (let ((x (ash (decode4 i) (* padding -8))))
            (bytevector-sint-set! bv (* i 3) x (endianness big) (- 3 padding))
            bv))
         ((< i groups)
          (bytevector-sint-set! bv (* i 3) (decode4 i) (endianness big) 3)
          (loop (+ i 1)))))
      bv)))