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 + +