anoia add base64 deode

pkgs/anoia/Makefile

@@ -2,8 +2,11 @@ servicedir:=$(shell mktemp -d)
 
 default: fs.lua init.lua nl.lua svc.lua net/constants.lua
 
+CHECK=fs.fnl init.fnl  svc.fnl
+
 check:
 	ln -s . anoia
+	fennel ./run-tests.fnl $(CHECK)
 	fennel test.fnl
 	fennel test-svc.fnl $(servicedir)
 	test -f $(servicedir)/fish

pkgs/anoia/init.fnl

@@ -1,3 +1,9 @@
+;; importing assert.fnl macros here would be circular, so we can't use
+;; the full test functionality
+(macro define-tests [& body]
+  (when _G.RUNNING_TESTS
+    `(do ,(unpack body))))
+
 (fn assoc [tbl k v & more]
   (tset tbl k v)
   (case more
@@ -52,7 +58,7 @@
              ;; there are no keys in b which are not also in a
              (and present (. a k))))))
 
-(comment
+(define-tests
  (assert (table= {:a 1 :b 2} {:b 2 :a 1}))
  (assert (not (table= {:a 1 :b 2 :k :l}  {:b 2 :a 1})))
  (assert (not (table= {:a 1 :b 2}  {:b 2 :a 1 :k :l})))
@@ -68,32 +74,32 @@
     [el] (. tree el)
     [] tree))
 
-(local
- base64-indices
- (doto [
-        "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P"
-        "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "a" "b" "c" "d" "e" "f"
-        "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v"
-        "w" "x" "y" "z" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "-" "_"
-        ]
-   (tset 0 "A")))
-
-;; local function base64(s)
-;;    local byte, rep = string.byte, string.rep
-;;    local pad = 2 - ((#s-1) % 3)
-;;    s = (s..rep('\0', pad)):gsub("...", function(cs)
-;;       local a, b, c = byte(cs, 1, 3)
-;;       return bs[a>>2] .. bs[(a&3)<<4|b>>4] .. bs[(b&15)<<2|c>>6] .. bs[c&63]
-;;    end)
-;;    return s:sub(1, #s-pad) .. rep('=', pad)
-;; end
-
 (fn %% [fmt ...] (string.format fmt ...))
 
-(fn base64url [s]
-  "URL-safe Base64-encoded form of s (no trailing padding)"
+(local
+ base64-indices
+ (let [base [
+         "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P"
+         "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "a" "b" "c" "d" "e" "f"
+         "g" "h" "i" "j" "k" "l" "m" "n" "o" "p" "q" "r" "s" "t" "u" "v"
+         "w" "x" "y" "z" "0" "1" "2" "3" "4" "5" "6" "7" "8" "9"
+         ]]
+   {
+    :url
+    (merge (dup base)
+           { 0 "A"
+             62 "-"
+             63 "_" })
+    :standard
+    (merge (dup base)
+           { 0 "A"
+             62 "+"
+             63 "/" })
+    }))
+
+
+(fn base64-encode [s bs]
   (let [pad (- 2 (% (- (# s) 1)  3))
-        bs base64-indices
         blank (string.rep "\0" pad)
         s (-> (.. s blank)
               (: :gsub
@@ -106,9 +112,71 @@
                          (. bs (band c 63)))))))]
     (s:sub 1 (- (# s) pad))))
 
+(fn base64-decode [input rindices]
+  ;; take groups of 4 characters, reverse-look them up in base64-indices,
+  ;; convert to 24 bit number,
+  ;; convert to three characters
+  (let [padding (if (= (string.sub input -2 -1) "==") -3
+                    (= (string.sub input -1 -1) "=") -2
+                    -1)
+        input (string.sub (.. input "===") 1 (* (/ (# input) 4) 4))]
+    (->
+     (icollect [s (string.gmatch input "(....)")]
+       (let [(a b c d) (string.byte s 1 4)
+             ri (fn [x] (assert (. rindices x) (.. "invalid " x)))
+             n (bor (ri d)
+                    (lshift (ri c) 6)
+                    (lshift (ri b) 12)
+                    (lshift (ri a) 18))]
+
+
+         (string.pack "bbb"
+                      (rshift (band 0xff0000 n) 16)
+                      (rshift (band 0x00ff00 n) 8)
+                      (band 0x0000ff n))))
+     (table.concat "")
+     (string.sub 1 padding)
+     )))
+
+(fn base64 [alphabet-des]
+  (let [alphabet (or (. base64-indices alphabet-des) alphabet-des (. base64-indices :standard) )
+        ralphabet (doto
+                      (collect [k v (pairs alphabet)]
+                        (values (string.byte v) k))
+                    (tset (string.byte "=") 0))]
+    {
+     :encode (fn [_ str] (base64-encode str alphabet))
+     :decode (fn [_ str] (base64-decode str ralphabet))
+     }))
+
+(fn base64url [str] (: (base64 :url) :encode str))
+
+
+
+(define-tests
+  (let [{: view} (require :fennel)
+        b64 (base64 :url)]
+
+    (let [a (b64:decode "YWxsIHlvdXIgYmFzZQ==")]
+      (assert (= a "all your base") (view a)))
+    (let [a (b64:decode "ZmVubmVsIHRoaW5n")]
+      (assert (= a "fennel thing")  a))
+    (let [a (b64:decode "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms=")]
+      (assert (= a "Many hands make light work") (view  a)))
+    (let [a (b64:encode "hello world")]
+      (assert (= a "aGVsbG8gd29ybGQ") a))))
+
+
+    ;; doesn't work if the padding is missing
+    ;; (let [a (from-base64 "TWFueSBoYW5kcyBtYWtlIGxpZ2h0IHdvcms")]
+    ;;   (assert (= a "Many hands make light work") (view  a)))
+;    ))
+
+
 
 {
  : assoc
+ : base64
  : base64url
  : basename
  : dig