diff --git a/app/Main.hs b/app/Main.hs index 2338421..c8efbb8 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -17,7 +17,7 @@ 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.Base62 (enc62, dec62) import Encoding.Base64 (enc64, dec64, enc64url, dec64url) import Encoding.Base85 (enc85, dec85) import Encoding.Base91 (enc91, dec91) @@ -35,7 +35,7 @@ data Based = Decode { b64 :: Bool, b64url :: Bool, url :: Bool, --- b62 :: Bool, + b62 :: Bool, b58 :: Bool, b45 :: Bool, b32 :: Bool, @@ -56,7 +56,7 @@ data Based = Decode { b64 :: Bool, b64url :: Bool, url :: Bool, --- b62 :: Bool, + b62 :: Bool, b58 :: Bool, b45 :: Bool, b32 :: Bool, @@ -161,8 +161,8 @@ optionHandler Decode{b64url=True} = dec64url optionHandler Encode{b64url=True} = enc64url optionHandler Decode{url=True} = decurl optionHandler Encode{url=True} = encurl ---optionHandler Decode{b62=True} = dec62 ---optionHandler Encode{b62=True} = enc62 +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 @@ -196,7 +196,7 @@ decodeMode = Decode { b64 = def &= help "decode base64", b64url = def &= help "decode base64Url", url = def &= help "decode URI", --- b62 = def &= help "decode base62", + b62 = def &= help "decode base62", b58 = def &= help "decode base58", b45 = def &= help "decode base45", b32 = def &= help "decode base32", @@ -219,7 +219,7 @@ encodeMode = Encode { b64 = def &= help "encode base64", b64url = def &= help "encode base64Url", url = def &= help "encode URI", --- b62 = def &= help "encode base62", + b62 = def &= help "encode base62", b58 = def &= help "encode base58", b45 = def &= help "encode base45", b32 = def &= help "encode base32", diff --git a/based.cabal b/based.cabal index 4b9f6f8..2531b19 100644 --- a/based.cabal +++ b/based.cabal @@ -41,6 +41,7 @@ library hxt, haskoin-core, text, + primitive, base64-bytestring default-language: Haskell2010 diff --git a/src/Encoding/Base62.hs b/src/Encoding/Base62.hs index 65971bb..7ac4959 100644 --- a/src/Encoding/Base62.hs +++ b/src/Encoding/Base62.hs @@ -1,32 +1,91 @@ +-- module Encoding.Base62 +-- ( enc62 +-- , dec62 +-- ) where + + +-- import qualified Data.Word.Base62 as B62 +-- import Text.Read (readMaybe) +-- import Data.Maybe (fromMaybe) +-- import Data.ByteString.UTF8 as BSU -- from utf8-string +-- import qualified Data.Bytes as Bytes +-- import Data.Bytes.Text.Latin1 as Latin1 +-- import qualified Data.ByteString.Char8 as C +-- import qualified Data.Text as T +-- import qualified Data.Text.Encoding as T +-- -- import qualified Data.Text.IO as T + + +-- dec62 :: String -> String +-- dec62 input = +-- let decoded = B62.decode128 (Bytes.fromByteString (BSU.fromString input)) +-- in fromMaybe "Error decoding Base62.\n" (show <$> decoded) +-- let decoded = BC.unpack $ B62.decode128 + +-- stringToInt :: String -> Maybe Integer +-- stringToInt = readMaybe + +-- enc62 :: String -> String +-- enc62 input = +-- let intValue = fromMaybe (error "Error: Unable to convert input string to integer") (stringToInt input) +-- encoded = B62.encode64 (fromIntegral intValue) +-- encodedText = T.decodeUtf8 (BSU.fromString (Latin1.toString (Bytes.fromByteArray encoded))) +-- in T.unpack encodedText + module Encoding.Base62 ( enc62 , dec62 ) where - -import qualified Data.Word.Base62 as B62 -import Text.Read (readMaybe) +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString as BS +import Data.ByteString.Internal (c2w, w2c) +import Data.List (elemIndex) import Data.Maybe (fromMaybe) -import Data.ByteString.UTF8 as BSU -- from utf8-string -import qualified Data.Bytes as Bytes -import Data.Bytes.Text.Latin1 as Latin1 -import qualified Data.ByteString.Char8 as C +import Numeric (showIntAtBase) +import Data.Char (intToDigit) import qualified Data.Text as T import qualified Data.Text.Encoding as T --- import qualified Data.Text.IO as T +import System.IO.Unsafe (unsafePerformIO) +import qualified Data.List as List +base62Chars :: String +base62Chars = ['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z'] -dec62 :: String -> String -dec62 input = - let decoded = B62.decode128 (Bytes.fromByteString (BSU.fromString input)) - in fromMaybe "Error decoding Base62.\n" (show <$> decoded) +-- Convert a ByteString to an Integer +byteStringToInteger :: BS.ByteString -> Integer +byteStringToInteger = BC.foldl' (\acc w -> acc * 256 + fromIntegral (c2w w)) 0 -stringToInt :: String -> Maybe Integer -stringToInt = readMaybe +-- Convert an Integer to a ByteString +integerToByteString :: Integer -> BS.ByteString +integerToByteString 0 = BC.singleton (w2c 0) +integerToByteString i = BC.reverse $ BC.unfoldr step i + where + step 0 = Nothing + step x = Just (w2c (fromIntegral (x `mod` 256)), x `div` 256) -enc62 :: String -> String +-- Encode an Integer to a Base62 ByteString +encodeBase62 :: Integer -> BS.ByteString +encodeBase62 0 = BC.singleton (base62Chars !! 0) +encodeBase62 n = BC.reverse $ BC.unfoldr step n + where + step 0 = Nothing + step x = let (q, r) = x `divMod` 62 + in Just (base62Chars !! fromIntegral r, q) + +decodeBase62 :: BS.ByteString -> Integer +decodeBase62 = BC.foldl' (\acc w -> acc * 62 + fromIntegral (fromMaybe 0 (elemIndex w base62Chars))) 0 + where + elemIndex :: Char -> String -> Maybe Int + elemIndex c str = List.findIndex (== c) str + +enc62 :: BC.ByteString -> BC.ByteString enc62 input = - let intValue = fromMaybe (error "Error: Unable to convert input string to integer") (stringToInt input) - encoded = B62.encode64 (fromIntegral intValue) - encodedText = T.decodeUtf8 (BSU.fromString (Latin1.toString (Bytes.fromByteArray encoded))) - in T.unpack encodedText + let intValue = byteStringToInteger input + in encodeBase62 intValue + +dec62 :: BC.ByteString -> BC.ByteString +dec62 input = + let decoded = decodeBase62 input + in integerToByteString decoded + diff --git a/test/Main.hs b/test/Main.hs index 601a185..3a3ec69 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -6,6 +6,7 @@ import Data.ByteString.UTF8 as BSU import Encoding.Base91 (enc91, dec91) import Encoding.Base85 (enc85, dec85) import Encoding.Base64 (enc64, dec64) +import Encoding.Base62 (enc62, dec62) import Encoding.Base45 (enc45, dec45) import Encoding.Base32 (enc32, dec32) import Encoding.Base16 (enc16, dec16) @@ -63,6 +64,18 @@ testDec64 = TestCase $ do assertEqual "for (dec64 \"AAEC\")," (BSU.fromString "\x00\x01\x02") (dec64 $ BSU.fromString "AAEC") assertEqual "for (dec64 \"8J+Ygg==\")," (BSU.fromString "😂") (dec64 $ BSU.fromString "8J+Ygg==") +testEnc62 :: Test +testEnc62 = TestCase $ do + assertEqual "for (enc62 \"Hello, World!\")," (BSU.fromString "1wJfrzvdbtXUOlUjUf") (enc62 helloWorldBS) + assertEqual "for (enc62 \"Haskell\")," (BSU.fromString "1VJEByfMCK") (enc62 haskellBS) + assertEqual "for (enc62 \"😂\")," (BSU.fromString "4PCnnm") (enc62 emojiBS) + +testDec62 :: Test +testDec62 = TestCase $ do + assertEqual "for (dec62 \"1wJfrzvdbtXUOlUjUf\")," helloWorldBS (dec62 $ BSU.fromString "1wJfrzvdbtXUOlUjUf") + assertEqual "for (dec62 \"1VJEByfMCK\")," haskellBS (dec62 $ BSU.fromString "1VJEByfMCK") + assertEqual "for (dec62 \"4PCnnm\")," emojiBS (dec62 $ BSU.fromString "4PCnnm") + testEnc45 :: Test testEnc45 = TestCase $ do assertEqual "for (enc45 \"Hello, World!\")," (BSU.fromString "%69 VDK2E:3404ESVDX0") (enc45 helloWorldBS) @@ -133,7 +146,7 @@ testEncQp = TestCase $ do testDecQp :: Test testDecQp = TestCase $ do assertEqual "for (decqp \"Hello,=20World!\")," helloWorldBS (decqp $ BSU.fromString "Hello,=20World!") - assertEqual "for (decqp \"QP=20works=20by=20using=20the=20equals=20sign=20=3D=20as=20an=20escape=20=\r\ncharacter.=20It=20also=20limits=20line=20length=20to=2076,=20as=20some=20=\r\nsoftware=20has=20limits=20on=20line=20length.\")," (BSU.fromString "QP works by using the equals sign = as an escape character. It also limits line length to 76, as some software has limits on line length.") (decqp $ BSU.fromString "QP=20works=20by=20using=20the=20equals=20sign=20=3D=20as=20an=20escape=20=\ncharacter.=20It=20also=20limits=20line=20length=20to=2076,=20as=20some=20=\nsoftware=20has=20limits=20on=20line=20length.") + assertEqual "for (decqp \"QP=20works=20by=20using=20the=20equals=20sign=20=3D=20as=20an=20escape=20=\r\ncharacter.=20It=20also=20limits=20line=20length=20to=2076,=20as=20some=20=\r\nsoftware=20has=20limits=20on=20line=20length.\")," (BSU.fromString "QP works by using the equals sign = as an escape character. It also limits line length to 76, as some software has limits on line length.") (decqp $ BSU.fromString "QP=20works=20by=20using=20the=20equals=20sign=20=3D=20as=20an=20escape=20=\r\ncharacter.=20It=20also=20limits=20line=20length=20to=2076,=20as=20some=20=\r\nsoftware=20has=20limits=20on=20line=20length.") assertEqual "for (decqp \"=F0=9F=98=82\")," emojiBS (decqp $ BSU.fromString "=F0=9F=98=82") -- testEnUu :: Test @@ -156,6 +169,8 @@ tests = TestList [TestLabel "Test enc91" testEnc91, TestLabel "Test dec85" testDec85, TestLabel "Test enc64" testEnc64, TestLabel "Test dec64" testDec64, + TestLabel "Test enc62" testEnc62, + TestLabel "Test dec62" testDec62, TestLabel "Test enc45" testEnc45, TestLabel "Test dec45" testDec45, TestLabel "Test enc32" testEnc32,