whx
/
based
1
0
Fork 0
Code Issues Pull Requests Projects Releases 9 Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
app/Main.hs
View File

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

56
src/Encoding/Base2.hs
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
( enc2
, dec2
) where
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 binStr = chr $ binaryToInt binStr
binaryToChar :: ByteString -> Char
binaryToChar binStr = chr $ binaryToInt (BC.unpack binStr)
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 input = map binaryToChar $ words input
dec2 :: ByteString -> ByteString
dec2 input = BC.pack . map binaryToChar . BC.words $ input
charToBinary :: Char -> String
charToBinary char = let binaryStr = intToBinary $ ord char
in replicate (7 - Prelude.length binaryStr) '0' ++ binaryStr
charToBinary :: Char -> ByteString
charToBinary char = BC.pack $ replicate (7 - length binaryStr) '0' ++ binaryStr
where
binaryStr = intToBinary (ord char)
intToBinary :: Int -> String
intToBinary n = reverse $ decimalToBinary' n
@ -25,6 +58,5 @@ intToBinary n = reverse $ decimalToBinary' n
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
enc2 :: ByteString -> ByteString
enc2 input = BC.unwords . map charToBinary . BC.unpack $ input

190
src/Encoding/Base45.hs
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
( enc45
, dec45
) where
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.Word (Word8)
base45Alphabet :: String
base45Alphabet = ['0'..'9'] ++ ['A'..'Z'] ++ " " ++ "$%*+-./:"
base45Alphabet :: ByteString
base45Alphabet = BC.pack $ ['0'..'9'] ++ ['A'..'Z'] ++ " " ++ "$%*+-./:"
enc45 :: String -> String
enc45 = concatMap (reverse . encodeChunk) . chunkBy 2 . map ord
enc45 :: ByteString -> ByteString
enc45 = BC.concat . map (BC.reverse . encodeChunk . map fromIntegral) . chunkBy 2 . B.unpack
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]
encodeChunk :: [Int] -> ByteString
encodeChunk [x1, x2] = BC.pack $ map (BC.index 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]
encodeChunk [x1] = BC.pack $ map (BC.index 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
dec45 :: ByteString -> ByteString
dec45 encoded = B.pack $ map fromIntegral decodedBytes
where
numericValues = map charToNumeric encoded
numericValues = map charToNumeric (BC.unpack 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"
charToNumeric c = fromJust $ BC.elemIndex c base45Alphabet
groupIntoThrees :: [Int] -> [[Int]]
groupIntoThrees [] = []
@ -96,13 +160,11 @@ groupIntoThrees xs
toBase45 :: [Int] -> Int
toBase45 [c, d, e] = c + d * 45 + e * (45 * 45)
toBase45 _ = error "Invalid Base45 group"
fromBase45 :: Int -> [Int]
fromBase45 n
| n >= 256 = fromBase45 (n `div` 256) ++ [n `mod` 256]
| otherwise = [n]
fromBase45 n = unfoldr (\x -> if x == 0 then Nothing else Just (x `mod` 256, x `div` 256)) n
bytesToChars :: [Int] -> String
bytesToChars :: [Int] -> [Char]
bytesToChars = map chr