diff --git a/app/Main.hs b/app/Main.hs index 348b0a7..2338421 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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", diff --git a/src/Encoding/Base2.hs b/src/Encoding/Base2.hs index bb6842c..e44e4d3 100644 --- a/src/Encoding/Base2.hs +++ b/src/Encoding/Base2.hs @@ -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 diff --git a/src/Encoding/Base45.hs b/src/Encoding/Base45.hs index c59e97d..91d9e4b 100644 --- a/src/Encoding/Base45.hs +++ b/src/Encoding/Base45.hs @@ -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 -