guile-examples/web-development/base64-encode-decode/decode.scm

(define-module (decode)
  #:use-module (rnrs base)
  #:use-module ((guile)
                #:select (lambda* λ
                           when unless
                           record-constructor
                           &programming-error
                           string-trim-right))
  #:use-module (ice-9 textual-ports)
  ;; SRFI 1: list procedures
  #:use-module ((srfi srfi-1)
                #:select (drop take first second third))
  ;; SRFI 69: hash tables
  #:use-module ((srfi srfi-69))
  #:use-module ((base-64) #:prefix base-64:)
  #:use-module (bit-integers)
  #:use-module (string-helpers)
  #:use-module (pipeline)
  #:use-module (ice-9 exceptions)
  #:export (decode))


(define make-invalid-base64-string-exception
  (record-constructor
   (make-exception-type '&invalid-base64-string
                        &programming-error
                        '(message))))


(define decode-8-bits
  (λ (bits)
    "Treat bits as an integer index into ASCII characters."
    (integer->char bits)))


;; TODO: IDEA: Make a more generic function for encoding chars, so
;; that it can be used in both encode and decode.
(define decode-4-chars
  (λ (chars)
    "Take 4 base64 characters and make 3 ASCII characters out of them."
    ;; A character in base64 is represented by 6 bits.
    (define char-width-base64 6)
    (let ([chars-as-ints (map base-64:char->integer chars)])
      ;; Concattenate the integers of the chars into a larger integer,
      ;; as a neutral intermediate representation between ASCII and
      ;; base64.
      (let ([concattenated (concat-integers chars-as-ints char-width-base64)]
            ;; A character in ASCII is represented by 8 bits.
            [char-width-ascii 8])
        (list->string
         (list (decode-8-bits (bit-integer-get-range concattenated
                                                     char-width-ascii
                                                     (* 2 char-width-ascii)))
               (decode-8-bits (bit-integer-get-range concattenated
                                                     char-width-ascii
                                                     char-width-ascii))
               (decode-8-bits (bit-integer-get-range concattenated
                                                     char-width-ascii
                                                     0))))))))


(define decode
  (λ (text)
    "Decode a base64 encoded string."
    (cond
     ;; A valid base64 string will be of a length divisible by 4.
     [(= (remainder (string-length text) 4) 0)
      (let ([char-width-base64 6]
            [char-width-ascii 8]
            [text-length (string-length text)]
            ;; ASSUMPTION: = characters can only be encountered at the
            ;; end of the string, because they are exclusively used as
            ;; the padding character.
            [padding-start-index (string-index text #\=)])
        ;; Remove the padding of the string (the = characters) and put
        ;; zeros there instead.

        ;; If no index for the padding char is found, it will result
        ;; in #f.
        (define padding-length (if padding-start-index
                                   (- text-length padding-start-index)
                                   0))
        (define text-without-padding
          (substring text
                     0
                     (- text-length padding-length)))

        ;; The char at 0 in base64 is #\A.
        (define text-with-zero-padding
          (call-with-output-string
            (λ (port)
              (put-string port text-without-padding)
              (do ((counter 1 (+ counter 1)))
                  ((> counter padding-length))
                (put-char port #\A)))))

        (define decoded-with-zeros
          (call-with-output-string
            (λ (port)
              (let iter ([chars° (string->list text-with-zero-padding)])
                (unless (null? chars°)
                  (put-string port (decode-4-chars (take chars° 4)))
                  (iter (drop chars° 4)))))))

        (string-trim-right decoded-with-zeros (λ (c) (char=? c #\nul))))]
     [else
      (raise-exception
       (make-exception
        (make-invalid-base64-string-exception "invalid base64 string")
        (make-exception-with-irritants (text))
        (make-exception-with-origin 'decode)))])))