From 87089a314b5db0b7ecb9ff13ffc0f9bf1d968d28 Mon Sep 17 00:00:00 2001
From: stefan <stefan@intheopen.org>
Date: Thu, 23 May 2024 22:32:15 +0200
Subject: [PATCH] added base45 encoding/decoding

---
 app/Main.hs            |   7 +++
 based                  |   1 +
 based.cabal            |   1 +
 src/Encoding/Base45.hs | 108 +++++++++++++++++++++++++++++++++++++++++
 4 files changed, 117 insertions(+)
 create mode 120000 based
 create mode 100644 src/Encoding/Base45.hs

diff --git a/app/Main.hs b/app/Main.hs
index 791176d..6f9eed8 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -13,6 +13,7 @@ import Encoding.Base8           (enc8, dec8)
 import Encoding.Base10          (enc10, dec10)
 import Encoding.Base16          (enc16, dec16)
 import Encoding.Base32          (enc32, dec32)
+import Encoding.Base45          (enc45, dec45)
 import Encoding.Base58          (enc58, dec58)
 import Encoding.Base62          (enc62, dec62)
 import Encoding.Base64          (enc64, dec64, enc64url, dec64url)
@@ -34,6 +35,7 @@ data Based = Decode {
               url :: Bool,
               b62 :: Bool,
               b58 :: Bool,
+              b45 :: Bool,
               b32 :: Bool,
               b16 :: Bool,
               b10 :: Bool,
@@ -54,6 +56,7 @@ data Based = Decode {
               url :: Bool,
               b62 :: Bool,
               b58 :: Bool,
+              b45 :: Bool,
               b32 :: Bool,
               b16 :: Bool,
               b10 :: Bool,
@@ -160,6 +163,8 @@ optionHandler Decode{b62=True} = dec62
 optionHandler Encode{b62=True} = enc62
 optionHandler Decode{b58=True} = dec58
 optionHandler Encode{b58=True} = enc58
+optionHandler Decode{b45=True} = dec45
+optionHandler Encode{b45=True} = enc45
 optionHandler Decode{b32=True} = dec32
 optionHandler Encode{b32=True} = enc32
 optionHandler Decode{b16=True} = dec16
@@ -191,6 +196,7 @@ decodeMode = Decode {
             url = def &= help "decode URI",
             b62 = def &= help "decode base62",
             b58 = def &= help "decode base58",
+            b45 = def &= help "decode base45",
             b32 = def &= help "decode base32",
             b16 = def &= help "decode base16",
             b10 = def &= help "decode decimal from hex",
@@ -213,6 +219,7 @@ encodeMode = Encode {
             url = def &= help "encode URI",
             b62 = def &= help "encode base62",
             b58 = def &= help "encode base58",
+            b45 = def &= help "encode base45",
             b32 = def &= help "encode base32",
             b16 = def &= help "encode base16",
             b10 = def &= help "encode base10 to hex",
diff --git a/based b/based
new file mode 120000
index 0000000..f124192
--- /dev/null
+++ b/based
@@ -0,0 +1 @@
+./dist-newstyle/build/aarch64-linux/ghc-9.4.8/based-0.4.3.0/x/based/build/based/based
\ No newline at end of file
diff --git a/based.cabal b/based.cabal
index 0f2f9fa..be81ea3 100644
--- a/based.cabal
+++ b/based.cabal
@@ -13,6 +13,7 @@ library
     Encoding.Base10
     Encoding.Base16
     Encoding.Base32
+    Encoding.Base45
     Encoding.Base58
     Encoding.Base62
     Encoding.Base64
diff --git a/src/Encoding/Base45.hs b/src/Encoding/Base45.hs
new file mode 100644
index 0000000..c59e97d
--- /dev/null
+++ b/src/Encoding/Base45.hs
@@ -0,0 +1,108 @@
+module Encoding.Base45
+  ( enc45
+  , dec45
+  ) where
+
+import Data.Char (chr, ord)
+import Data.List (elemIndex)
+import Data.Maybe (fromJust)
+
+base45Alphabet :: String
+base45Alphabet = ['0'..'9'] ++ ['A'..'Z'] ++ " " ++ "$%*+-./:"
+
+enc45 :: String -> String
+enc45 = concatMap (reverse . encodeChunk) . chunkBy 2 . map ord
+
+chunkBy :: Int -> [a] -> [[a]]
+chunkBy _ [] = []
+chunkBy n xs = take n xs : chunkBy n (drop n xs)
+
+encodeChunk :: [Int] -> String
+encodeChunk [x1, x2] = map (base45Alphabet !!) [c, b, a]
+  where
+    n = x1 * 256 + x2
+    a = n `mod` 45
+    b = (n `div` 45) `mod` 45
+    c = n `div` 2025
+encodeChunk [x1] = map (base45Alphabet !!) [b, a]
+  where
+    a = x1 `mod` 45
+    b = x1 `div` 45
+encodeChunk _ = error "Invalid chunk length"
+
+-- Decode
+dec45 :: String -> String
+dec45 encoded = bytesToChars decodedBytes
+  where
+    numericValues = map charToNumeric encoded
+    groups = groupIntoThrees numericValues
+    base45Values = map toBase45 groups
+    decodedBytes = concatMap fromBase45 base45Values
+
+charToNumeric :: Char -> Int
+charToNumeric c = case c of
+  '0' -> 0
+  '1' -> 1
+  '2' -> 2
+  '3' -> 3
+  '4' -> 4
+  '5' -> 5
+  '6' -> 6
+  '7' -> 7
+  '8' -> 8
+  '9' -> 9
+  'A' -> 10
+  'B' -> 11
+  'C' -> 12
+  'D' -> 13
+  'E' -> 14
+  'F' -> 15
+  'G' -> 16
+  'H' -> 17
+  'I' -> 18
+  'J' -> 19
+  'K' -> 20
+  'L' -> 21
+  'M' -> 22
+  'N' -> 23
+  'O' -> 24
+  'P' -> 25
+  'Q' -> 26
+  'R' -> 27
+  'S' -> 28
+  'T' -> 29
+  'U' -> 30
+  'V' -> 31
+  'W' -> 32
+  'X' -> 33
+  'Y' -> 34
+  'Z' -> 35
+  ' ' -> 36
+  '$' -> 37
+  '%' -> 38
+  '*' -> 39
+  '+' -> 40
+  '-' -> 41
+  '.' -> 42
+  '/' -> 43
+  ':' -> 44
+  _ -> error "Invalid Base45 character"
+
+groupIntoThrees :: [Int] -> [[Int]]
+groupIntoThrees [] = []
+groupIntoThrees xs
+  | length xs < 3 = [xs ++ replicate (3 - length xs) 0]
+  | otherwise = take 3 xs : groupIntoThrees (drop 3 xs)
+
+toBase45 :: [Int] -> Int
+toBase45 [c, d, e] = c + d * 45 + e * (45 * 45)
+
+fromBase45 :: Int -> [Int]
+fromBase45 n
+  | n >= 256 = fromBase45 (n `div` 256) ++ [n `mod` 256]
+  | otherwise = [n]
+
+bytesToChars :: [Int] -> String
+bytesToChars = map chr
+
+