Changed base45 to Bytestring in and output

This commit is contained in:
Stefan Friese 2024-06-08 22:04:28 +02:00
parent a472d309a6
commit b6ad312970
3 changed files with 184 additions and 90 deletions

View File

@ -10,12 +10,12 @@ import System.Console.CmdArgs
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Char8 as BC
--import Text.Regex.TDFA --import Text.Regex.TDFA
--import Encoding.Base2 (enc2, dec2) import Encoding.Base2 (enc2, dec2)
import Encoding.Base8 (enc8, dec8) import Encoding.Base8 (enc8, dec8)
import Encoding.Base10 (enc10, dec10) import Encoding.Base10 (enc10, dec10)
import Encoding.Base16 (enc16, dec16) import Encoding.Base16 (enc16, dec16)
import Encoding.Base32 (enc32, dec32) import Encoding.Base32 (enc32, dec32)
--import Encoding.Base45 (enc45, dec45) import Encoding.Base45 (enc45, dec45)
import Encoding.Base58 (enc58, dec58) import Encoding.Base58 (enc58, dec58)
--import Encoding.Base62 (enc62, dec62) --import Encoding.Base62 (enc62, dec62)
import Encoding.Base64 (enc64, dec64, enc64url, dec64url) import Encoding.Base64 (enc64, dec64, enc64url, dec64url)
@ -37,12 +37,12 @@ data Based = Decode {
url :: Bool, url :: Bool,
-- b62 :: Bool, -- b62 :: Bool,
b58 :: Bool, b58 :: Bool,
-- b45 :: Bool, b45 :: Bool,
b32 :: Bool, b32 :: Bool,
b16 :: Bool, b16 :: Bool,
b10 :: Bool, b10 :: Bool,
b8 :: Bool, b8 :: Bool,
-- b2 :: Bool, b2 :: Bool,
qp :: Bool, qp :: Bool,
uu :: Bool, uu :: Bool,
xx :: Bool, xx :: Bool,
@ -58,12 +58,12 @@ data Based = Decode {
url :: Bool, url :: Bool,
-- b62 :: Bool, -- b62 :: Bool,
b58 :: Bool, b58 :: Bool,
-- b45 :: Bool, b45 :: Bool,
b32 :: Bool, b32 :: Bool,
b16 :: Bool, b16 :: Bool,
b10 :: Bool, b10 :: Bool,
b8 :: Bool, b8 :: Bool,
-- b2 :: Bool, b2 :: Bool,
qp :: Bool, qp :: Bool,
uu :: Bool, uu :: Bool,
xx :: Bool, xx :: Bool,
@ -165,8 +165,8 @@ optionHandler Encode{url=True} = encurl
--optionHandler Encode{b62=True} = enc62 --optionHandler Encode{b62=True} = enc62
optionHandler Decode{b58=True} = dec58 optionHandler Decode{b58=True} = dec58
optionHandler Encode{b58=True} = enc58 optionHandler Encode{b58=True} = enc58
--optionHandler Decode{b45=True} = dec45 optionHandler Decode{b45=True} = dec45
--optionHandler Encode{b45=True} = enc45 optionHandler Encode{b45=True} = enc45
optionHandler Decode{b32=True} = dec32 optionHandler Decode{b32=True} = dec32
optionHandler Encode{b32=True} = enc32 optionHandler Encode{b32=True} = enc32
optionHandler Decode{b16=True} = dec16 optionHandler Decode{b16=True} = dec16
@ -175,8 +175,8 @@ optionHandler Decode{b10=True} = dec10
optionHandler Encode{b10=True} = enc10 optionHandler Encode{b10=True} = enc10
optionHandler Decode{b8=True} = dec8 optionHandler Decode{b8=True} = dec8
optionHandler Encode{b8=True} = enc8 optionHandler Encode{b8=True} = enc8
--optionHandler Decode{b2=True} = dec2 optionHandler Decode{b2=True} = dec2
--optionHandler Encode{b2=True} = enc2 optionHandler Encode{b2=True} = enc2
optionHandler Decode{qp=True} = decqp optionHandler Decode{qp=True} = decqp
optionHandler Encode{qp=True} = encqp optionHandler Encode{qp=True} = encqp
optionHandler Encode{uu=True} = encuu optionHandler Encode{uu=True} = encuu
@ -198,12 +198,12 @@ decodeMode = Decode {
url = def &= help "decode URI", url = def &= help "decode URI",
-- b62 = def &= help "decode base62", -- b62 = def &= help "decode base62",
b58 = def &= help "decode base58", b58 = def &= help "decode base58",
-- b45 = def &= help "decode base45", b45 = def &= help "decode base45",
b32 = def &= help "decode base32", b32 = def &= help "decode base32",
b16 = def &= help "decode base16", b16 = def &= help "decode base16",
b10 = def &= help "decode decimal from hex", b10 = def &= help "decode decimal from hex",
b8 = def &= help "decode octal from hex", b8 = def &= help "decode octal from hex",
-- b2 = def &= help "decode binary from hex", b2 = def &= help "decode base2",
qp = def &= help "decode quoted-printable", qp = def &= help "decode quoted-printable",
uu = def &= help "decode uu", uu = def &= help "decode uu",
xx = def &= help "decode xx", xx = def &= help "decode xx",
@ -221,12 +221,12 @@ encodeMode = Encode {
url = def &= help "encode URI", url = def &= help "encode URI",
-- b62 = def &= help "encode base62", -- b62 = def &= help "encode base62",
b58 = def &= help "encode base58", b58 = def &= help "encode base58",
-- b45 = def &= help "encode base45", b45 = def &= help "encode base45",
b32 = def &= help "encode base32", b32 = def &= help "encode base32",
b16 = def &= help "encode base16", b16 = def &= help "encode base16",
b10 = def &= help "encode base10 to hex", b10 = def &= help "encode base10 to hex",
b8 = def &= help "encode octal to hex", b8 = def &= help "encode octal to hex",
-- b2 = def &= help "encode binary to hex", b2 = def &= help "encode base2",
qp = def &= help "encode quoted-printable", qp = def &= help "encode quoted-printable",
uu = def &= help "encode uu", uu = def &= help "encode uu",
xx = def &= help "encode xx", xx = def &= help "encode xx",

View File

@ -1,23 +1,56 @@
-- module Encoding.Base2
-- ( enc2
-- , dec2
-- ) where
-- import Data.Char (ord, chr, digitToInt, intToDigit)
-- binaryToChar :: String -> Char
-- binaryToChar binStr = chr $ binaryToInt binStr
-- binaryToInt :: String -> Int
-- binaryToInt binStr = Prelude.foldl (\acc x -> acc * 2 + digitToInt x) 0 binStr
-- dec2 :: String -> String
-- dec2 input = map binaryToChar $ words input
-- charToBinary :: Char -> String
-- charToBinary char = let binaryStr = intToBinary $ ord char
-- in replicate (7 - Prelude.length binaryStr) '0' ++ binaryStr
-- intToBinary :: Int -> String
-- intToBinary n = reverse $ decimalToBinary' n
-- where
-- decimalToBinary' 0 = "0"
-- decimalToBinary' m = let (q, r) = m `divMod` 2 in intToDigit r : decimalToBinary' q
-- enc2 :: String -> String
-- enc2 input = unwords $ map charToBinary input
module Encoding.Base2 module Encoding.Base2
( enc2 ( enc2
, dec2 , dec2
) where ) where
import Data.Char (ord, chr, digitToInt, intToDigit) import Data.Char (ord, chr, digitToInt, intToDigit)
import qualified Data.ByteString.Char8 as BC
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
binaryToChar :: String -> Char binaryToChar :: ByteString -> Char
binaryToChar binStr = chr $ binaryToInt binStr binaryToChar binStr = chr $ binaryToInt (BC.unpack binStr)
binaryToInt :: String -> Int binaryToInt :: String -> Int
binaryToInt binStr = Prelude.foldl (\acc x -> acc * 2 + digitToInt x) 0 binStr binaryToInt binStr = foldl (\acc x -> acc * 2 + digitToInt x) 0 binStr
dec2 :: String -> String dec2 :: ByteString -> ByteString
dec2 input = map binaryToChar $ words input dec2 input = BC.pack . map binaryToChar . BC.words $ input
charToBinary :: Char -> ByteString
charToBinary :: Char -> String charToBinary char = BC.pack $ replicate (7 - length binaryStr) '0' ++ binaryStr
charToBinary char = let binaryStr = intToBinary $ ord char where
in replicate (7 - Prelude.length binaryStr) '0' ++ binaryStr binaryStr = intToBinary (ord char)
intToBinary :: Int -> String intToBinary :: Int -> String
intToBinary n = reverse $ decimalToBinary' n intToBinary n = reverse $ decimalToBinary' n
@ -25,6 +58,5 @@ intToBinary n = reverse $ decimalToBinary' n
decimalToBinary' 0 = "0" decimalToBinary' 0 = "0"
decimalToBinary' m = let (q, r) = m `divMod` 2 in intToDigit r : decimalToBinary' q decimalToBinary' m = let (q, r) = m `divMod` 2 in intToDigit r : decimalToBinary' q
enc2 :: String -> String enc2 :: ByteString -> ByteString
enc2 input = unwords $ map charToBinary input enc2 input = BC.unwords . map charToBinary . BC.unpack $ input

View File

@ -1,92 +1,156 @@
-- 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
module Encoding.Base45 module Encoding.Base45
( enc45 ( enc45
, dec45 , dec45
) where ) where
import Data.Char (chr, ord) import Data.Char (chr, ord)
import Data.List (elemIndex) import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.List (unfoldr)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Word (Word8)
base45Alphabet :: String base45Alphabet :: ByteString
base45Alphabet = ['0'..'9'] ++ ['A'..'Z'] ++ " " ++ "$%*+-./:" base45Alphabet = BC.pack $ ['0'..'9'] ++ ['A'..'Z'] ++ " " ++ "$%*+-./:"
enc45 :: String -> String enc45 :: ByteString -> ByteString
enc45 = concatMap (reverse . encodeChunk) . chunkBy 2 . map ord enc45 = BC.concat . map (BC.reverse . encodeChunk . map fromIntegral) . chunkBy 2 . B.unpack
chunkBy :: Int -> [a] -> [[a]] chunkBy :: Int -> [a] -> [[a]]
chunkBy _ [] = [] chunkBy _ [] = []
chunkBy n xs = take n xs : chunkBy n (drop n xs) chunkBy n xs = take n xs : chunkBy n (drop n xs)
encodeChunk :: [Int] -> String encodeChunk :: [Int] -> ByteString
encodeChunk [x1, x2] = map (base45Alphabet !!) [c, b, a] encodeChunk [x1, x2] = BC.pack $ map (BC.index base45Alphabet) [c, b, a]
where where
n = x1 * 256 + x2 n = x1 * 256 + x2
a = n `mod` 45 a = n `mod` 45
b = (n `div` 45) `mod` 45 b = (n `div` 45) `mod` 45
c = n `div` 2025 c = n `div` 2025
encodeChunk [x1] = map (base45Alphabet !!) [b, a] encodeChunk [x1] = BC.pack $ map (BC.index base45Alphabet) [b, a]
where where
a = x1 `mod` 45 a = x1 `mod` 45
b = x1 `div` 45 b = x1 `div` 45
encodeChunk _ = error "Invalid chunk length" encodeChunk _ = error "Invalid chunk length"
-- Decode dec45 :: ByteString -> ByteString
dec45 :: String -> String dec45 encoded = B.pack $ map fromIntegral decodedBytes
dec45 encoded = bytesToChars decodedBytes
where where
numericValues = map charToNumeric encoded numericValues = map charToNumeric (BC.unpack encoded)
groups = groupIntoThrees numericValues groups = groupIntoThrees numericValues
base45Values = map toBase45 groups base45Values = map toBase45 groups
decodedBytes = concatMap fromBase45 base45Values decodedBytes = concatMap fromBase45 base45Values
charToNumeric :: Char -> Int charToNumeric :: Char -> Int
charToNumeric c = case c of charToNumeric c = fromJust $ BC.elemIndex c base45Alphabet
'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 :: [Int] -> [[Int]]
groupIntoThrees [] = [] groupIntoThrees [] = []
@ -96,13 +160,11 @@ groupIntoThrees xs
toBase45 :: [Int] -> Int toBase45 :: [Int] -> Int
toBase45 [c, d, e] = c + d * 45 + e * (45 * 45) toBase45 [c, d, e] = c + d * 45 + e * (45 * 45)
toBase45 _ = error "Invalid Base45 group"
fromBase45 :: Int -> [Int] fromBase45 :: Int -> [Int]
fromBase45 n fromBase45 n = unfoldr (\x -> if x == 0 then Nothing else Just (x `mod` 256, x `div` 256)) n
| n >= 256 = fromBase45 (n `div` 256) ++ [n `mod` 256]
| otherwise = [n]
bytesToChars :: [Int] -> String bytesToChars :: [Int] -> [Char]
bytesToChars = map chr bytesToChars = map chr