#!/usr/bin/env runhaskell {-# LANGUAGE DeriveDataTypeable #-} module Main where import System.Console.CmdArgs import Control.Arrow import Data.Text (pack, unpack, Text) import Data.Bits -- import Data.Char import Text.Read (readMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T -- import Data.Text (Text) import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Encoding (decodeUtf8With, decodeUtf8, encodeUtf8) import Data.Maybe (fromJust, fromMaybe) import Data.Text.Encoding.Error (lenientDecode) import TextShow (toText) import Text.XML.HXT.DOM.Util (hexStringToInt, intToHexString, decimalStringToInt) import TextShow.Data.Integral (showbBin, showbOct) import Text.Ascii (fromBinDigit, fromOctDigit) import Codec.CBOR.Magic (intToWord64) import qualified Data.Either.Unwrap as U import Data.Bytes.Text.Latin1 as Latin1 import qualified Codec.Binary.Base91 as B91 import qualified Codec.Binary.Base85 as B85 import qualified Codec.Binary.Base64 as B64 import qualified Data.ByteString.Base64 as B64L import qualified Codec.Binary.Base64Url as B64U import qualified Network.HTTP.Base as HB import qualified Data.Word.Base62 as B62 import qualified Haskoin.Address.Base58 as B58 import qualified Codec.Binary.Base32 as B32 import qualified Codec.Binary.Base16 as B16 import qualified Codec.Binary.QuotedPrintable as QP import qualified Codec.Binary.Uu as UU import qualified Codec.Binary.Xx as XX import qualified Codec.Binary.Yenc as Y import qualified Data.Bytes as Bytes import qualified Data.Bytes.Text.Ascii as ASCII import Data.Bytes.Get (getWord64host) import Data.ByteString.UTF8 as BSU -- from utf8-string -- import Data.ByteString (singleton) import GHC.Word (Word8) import qualified Data.ByteString.Char8 as C -- Regex imports import Text.Regex.TDFA import Data.Word (Word8) import Data.Char (ord, chr, intToDigit, digitToInt) data Based = Decode { b91 :: Bool, b85 :: Bool, b64 :: Bool, b64url :: Bool, url :: Bool, b62 :: Bool, b58 :: Bool, b32 :: Bool, b16 :: Bool, b10 :: Bool, b8 :: Bool, b2 :: Bool, qp :: Bool, uu :: Bool, xx :: Bool, yenc :: Bool, solve :: Bool } | Encode { b91 :: Bool, b85 :: Bool, b64 :: Bool, b64url :: Bool, url :: Bool, b62 :: Bool, b58 :: Bool, b32 :: Bool, b16 :: Bool, b10 :: Bool, b8 :: Bool, b2 :: Bool, qp :: Bool, uu :: Bool, xx :: Bool, yenc :: Bool } deriving(Show, Data, Typeable) -- helper functions -- convertToByteString :: String -> Either String C.ByteString -- convertToByteString str = -- case BSU.fromString str of -- Just bs -> Right bs -- Nothing -> Left "Failed to convert string to ByteString." -- decodeFromBase91 :: String -> Either String C.ByteString -- decodeFromBase91 decoded = -- case B91.decode of -- decoded | C.null decoded -> Left "Failed to decode from base91" -- | otherwise -> Right decoded encodeToBase64 :: C.ByteString -> Either String C.ByteString encodeToBase64 bs = case B64.encode bs of encoded | C.null encoded -> Left "Failed to encode Base64.\n" | otherwise -> Right encoded decodeFromBase64 :: C.ByteString -> Either String C.ByteString decodeFromBase64 bs = case B64L.decodeLenient bs of decoded | C.null decoded -> Left "Failed to decode from Base64.\n" | otherwise -> Right decoded -- | otherwise -> Right (BSU.toString decoded) -- Left err -> Left $ "Failed to decode from base64: " ++ err -- Right decoded -> Right decoded binToInt :: [Int] -> Int binToInt [] = 0 binToInt (x : xs) = x + 2 * binToInt xs octToInt :: [Int] -> Int octToInt [] = 0 octToInt (x : xs) = x + 8 * octToInt xs -- base functions -- without the show func, sequences like \n will not be shown as characters but will be executed as newline dec91 :: String -> String dec91 = T.unpack . T.decodeUtf8 . B91.decode -- dec91 input = -- maybe "Error decoding Base91.\n" T.unpack (T.decodeUtf8 (B91.decode input) -- dec91 :: String -> String -- dec91 input = -- case B91.decode input :: BSU.ByteString of -- decoded -> C.unpack decoded -- toWord8 :: String -> [Word8] -- toWord8 = map (fromIntegral . fromEnum) -- dec91 :: String -> String -- dec91 input = -- map (chr . fromIntegral) (B91.decode input :: [Word8]) -- or -- case B91.decode input :: [Word8] of -- Right decoded -> map (toEnum . fromIntegral) decoded -- Left err -> "Error decoding Base91: " ++ err enc91 :: String -> String enc91 = B91.encode . BSU.fromString -- dec85 = C.unpack . U.fromRight . B85.decode . BSU.fromString dec85 :: String -> String dec85 input = case B85.decode (BSU.fromString input) of Right decodedStr -> C.unpack decodedStr Left _ -> "Error decoding Base85.\n" enc85 :: String -> String enc85 = C.unpack . B85.encode . BSU.fromString -- dec64 = C.unpack . B64L.decodeLenient . BSU.fromString dec64 :: String -> String dec64 input = case decodeFromBase64 (BSU.fromString input) of Right byteString -> C.unpack byteString Left errMsg -> "Error: " ++ errMsg -- enc64 = C.unpack . B64.encode . BSU.fromString enc64 :: String -> String enc64 input = case encodeToBase64 (BSU.fromString input) of Right byteString -> C.unpack byteString Left errMsg -> "Error: " ++ errMsg dec64url :: String -> String -- dec64url = C.unpack . U.fromRight . B64U.decode . BSU.fromString dec64url input = case B64.decode (BSU.fromString input) of Right decoded -> C.unpack decoded Left _ -> "Error decoding Base64 for URLs.\n" enc64url :: String -> String enc64url = C.unpack . B64U.encode . BSU.fromString decurl :: String -> String decurl = HB.urlDecode encurl :: String -> String encurl = HB.urlEncode dec62 :: String -> String -- dec62 = T.unpack . B62.text128 . fromJust . B62.decode128 . Bytes.fromAsciiString -- dec62 input = -- case B62.decode128 (Bytes.fromAsciiString input) of -- Just decoded -> (T.unpack (B62.text128 decoded)) -- -- Just decoded -> C.unpack decoded -- Nothing -> "Error decoding Base62.\n" -- dec62 = show . fromJust . B62.decode128 . (Bytes.fromByteString . BSU.fromString) dec62 input = let decoded = B62.decode128 (Bytes.fromByteString (BSU.fromString input)) in fromMaybe "Error decoding Base62.\n" (show <$> decoded) -- dec62 input = -- maybe "Error decoding Base62.\n" show (B62.decode128 (Bytes.fromByteString (BSU.fromString input))) stringToInt :: String -> Maybe Integer stringToInt = readMaybe -- enc62 :: String -> String -- enc62 = C.unpack . BSU.fromString. Latin1.toString . (Bytes.fromByteArray . ( B62.encode64 . (intToWord64 . decimalStringToInt))) -- enc62 = T.unpack . T.decodeUtf8 . BSU.fromString . Latin1.toString . (Bytes.fromByteArray . ( B62.encode64 . (intToWord64 . decimalStringToInt))) -- enc62 = T.unpack . T.decodeUtf8 . BSU.fromString . Latin1.toString . (Bytes.fromByteArray . (B62.encode128 . (fromIntegral . ( BSU.fromString . fromJust StringToInt)))) -- working correct: -- enc62 :: String -> String -- enc62 = T.unpack . T.decodeUtf8 . BSU.fromString . Latin1.toString . Bytes.fromByteArray . B62.encode64 . fromIntegral . fromJust . stringToInt 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 -- enc62 :: Text -> Text -- enc62 text = B62.text128 (fromIntegral (T.length text)) dec58 :: String -> String -- dec58 = C.unpack . fromJust . B58.decodeBase58 . pack dec58 input = maybe "Error decoding Base58.\n" C.unpack (B58.decodeBase58 (T.pack input)) enc58 :: String -> String enc58 = T.unpack . B58.encodeBase58 . BSU.fromString dec32 :: String -> String -- dec32 = C.unpack . U.fromRight . B32.decode . BSU.fromString dec32 input = case B32.decode (BSU.fromString input) of Right decoded -> C.unpack decoded Left _ -> "Error decoding Base32.\n" enc32 :: String -> String enc32 = C.unpack . B32.encode . BSU.fromString dec16 :: String -> String -- dec16 = C.unpack . U.fromRight . B16.decode . BSU.fromString dec16 input = case B16.decode (BSU.fromString input) of Right decoded -> C.unpack decoded Left _ -> "Error decoding Base16.\n" enc16 :: String -> String enc16 = C.unpack . B16.encode . BSU.fromString dec10 :: String -> String dec10 = show . hexStringToInt enc10 :: String -> String -- enc10 = C.unpack . BSU.fromString . intToHexString . decimalStringToInt -- Depending on what you want, do enc10 = show . map ord enc10 str = C.unpack $ C.pack $ Prelude.foldl (\acc char -> acc ++ show (ord char)) "" str -- decode octal octalToChar :: String -> Char octalToChar str = chr $ Prelude.foldl (\acc c -> acc * 8 + read [c]) 0 str chunksOf :: Int -> [a] -> [[a]] chunksOf _ [] = [] chunksOf n xs = Prelude.take n xs : chunksOf n (Prelude.drop n xs) decodeOctal :: String -> String decodeOctal = map octalToChar . words -- decodeOctal :: String -> String -- decodeOctal = map (octalToChar . padOctal) . words -- where -- -- Function to pad an octal number string with leading '0's if needed -- padOctal str -- | Prelude.length str == 1 && str /= "0" = "00" ++ str -- | Prelude.length str == 2 && str /= "0" = "0" ++ str -- | otherwise = str -- Function to decode a string of octal numbers to characters dec8 :: String -> String dec8 = map octalToChar . chunksOf 3 . filter (/= ' ') -- dec8 :: String -> String -- dec8 = C.unpack . encodeUtf8 . toText . showbOct . hexStringToInt -- newtype Octal = Octal Int -- octalToString :: Octal -> String -- octalToString (Octal n) = show n -- dec8 = map (chr . octalToDecimal) . chunksOf 3 -- where -- octalToDecimal :: Octal -> Int -- octalToDecimal (Octal n) = Prelude.foldl (\acc c -> acc * 8 + digitToInt c) O (show n) -- chunksOf :: Int -> [a] -> [[a]] -- chunksOf _ [] = [] -- chunksOf n xs = Prelude.take n xs : chunksOf n (Prelude.drop n xs) -- enc8 :: String -> String -- enc8 = C.unpack . BSU.fromString . intToHexString . octToInt . (reverse . (map fromJust . (map fromOctDigit))) -- -- unicodeToOctal :: Char -> String -- unicodeToOctal c -- | ord c >= 0 && ord c <= 7 = ['0', intToDigit (ord c)] -- | otherwise = padTo3Bits $ decimalToOctal' (ord c) -- where -- decimalToOctal' 0 = "" -- decimalToOctal' m = let (q, r) = m `divMod` 8 in intToDigit r : decimalToOctal' q -- padTo3Bits :: String -> String -- padTo3Bits bits -- | Prelude.length bits < 3 = replicate (3 - Prelude.length bits) '0' ++ bits -- | otherwise = bits -- enc8 :: String -> String -- enc8 = unwords . map (concatMap unicodeToOctal . (:[])) unicodeToOctal :: Char -> [String] unicodeToOctal c = chunksOf 3 $ reverse $ decimalToOctal' (ord c) where decimalToOctal' 0 = "0" decimalToOctal' m = let (q, r) = m `divMod` 8 in intToDigit r : if q == 0 then "" else decimalToOctal' q enc8 :: String -> String enc8 = unwords . concatMap unicodeToOctal -- unicodeToOctal :: Char -> String -- unicodeToOctal c = reverse $ padTo3Bits $ decimalToOctal' (ord c) -- where -- decimalToOctal' 0 = "0" -- decimalToOctal' m = let (q, r) = m `divMod` 8 in intToDigit r : decimalToOctal' q -- padTo3Bits :: String -> String -- padTo3Bits bits = replicate (3 - Prelude.length bits) '0' ++ bits -- enc8 :: String -> String -- enc8 = concatMap unicodeToOctal dec2 :: String -> String -- dec2 = C.unpack . encodeUtf8 . toText . showbBin . hexStringToInt -- dec2 = TL.unpack . toLazyText . showbBin . hexStringToInt . enc16 dec2 = TL.unpack . toLazyText . showbBin . hexStringToInt enc2 :: String -> String -- enc2 = C.unpack . BSU.fromString . intToHexString . binToInt . (reverse . (map fromJust . (map fromBinDigit))) -- enc2 input = C.unpack $ C.pack $ show $ Prelude.foldl (\acc char -> (acc `shiftL` 8) .|. fromIntegral (ord char)) BSU.fromString enc2 input = concatMap (\c -> padTo7Bits (decimalToBinary (ord c))) input where decimalToBinary :: Int -> String decimalToBinary 0 = "0" decimalToBinary n = reverse $ decimalToBinary' n where decimalToBinary' 0 = "" decimalToBinary' m = let (q, r) = m `divMod` 2 in (if r == 0 then '0' else '1') : decimalToBinary' q padTo7Bits :: String -> String padTo7Bits bits = replicate (7 - Prelude.length bits) '0' ++ bits decqp :: String -> String -- decqp = C.unpack . U.fromRight . QP.decode . BSU.fromString decqp input = case QP.decode (BSU.fromString input) of Right decoded -> C.unpack decoded Left _ -> "Error decoding QP.\n" encqp :: String -> String encqp = C.unpack . QP.encode . BSU.fromString decuu :: String -> String -- decuu = C.unpack . U.fromRight . UU.decode . BSU.fromString decuu input = case UU.decode (BSU.fromString input) of Right decoded -> C.unpack decoded Left _ -> "Error decoding UU.\n" encuu :: String -> String encuu = C.unpack . UU.encode . BSU.fromString decxx :: String -> String -- decxx = C.unpack . U.fromRight . XX.decode . BSU.fromString decxx input = case XX.decode (BSU.fromString input) of Right decoded -> C.unpack decoded Left _ -> "Error decoding XX.\n" encxx :: String -> String encxx = C.unpack . XX.encode . BSU.fromString decy :: String -> String -- decy = C.unpack . U.fromRight . Y.decode . BSU.fromString decy input = case Y.decode (BSU.fromString input) of Right decoded -> C.unpack decoded Left _ -> "Error decoding Y.\n" ency :: String -> String ency = C.unpack . Y.encode . BSU.fromString base91Regex = "^[!-~]*$" base85Regex = "^[0-9A-Za-z!#$%&()*+,-;<=>?@^_`{|}~]+$" -- base85Regex = "^[A-Za-u0-9!\"#$%&((*+,-./;:<=@[]\\`]*$" base64Regex = "^([A-Za-z0-9+/]{4})*([A-Za-z0-9+/]{3}=|[A-Za-z0-9+/]{2}==)?$" base58Regex = "^[1-9A-HJ-NP-Za-km-z]+$" -- incorrect base32Regex = "^(?:[A-Z2-7]{8})*(?:[A-Z2-7]{2}={6}|[A-Z2-7]{4}={4}|[A-Z2-7]{5}={3}|[A-Z2-7]{7}=)?$" base16Regex = "^[0-9A-FXx]*$" base10Regex = "^[0-9]*$" base8Regex = "^[0-7]*$" base2Regex = "^[01]*$" urlRegex = "^[a-zA-Z0-9%]*$" solveEnc :: String -> String solveEnc input = let isBase91 = BSU.fromString input =~ base91Regex :: Bool isBase85 = BSU.fromString input =~ base85Regex :: Bool isBase64 = BSU.fromString input =~ base64Regex :: Bool isBase58 = BSU.fromString input =~ base58Regex :: Bool isBase32 = BSU.fromString input =~ base32Regex :: Bool isBase16 = BSU.fromString input =~ base16Regex :: Bool isBase10 = BSU.fromString input =~ base10Regex :: Bool isBase8 = BSU.fromString input =~ base8Regex :: Bool isBase2 = BSU.fromString input =~ base2Regex :: Bool isURL = BSU.fromString input =~ urlRegex :: Bool base91Result = if isBase91 then "\nTrying base91:\n" ++ dec91 input else "" base85Result = if isBase85 then "\nTrying base85:\n" ++ dec85 input else "" base64Result = if isBase64 then "\nTrying base64:\n" ++ dec64 input else "" base58Result = if isBase58 then "\nTrying base58:\n" ++ dec58 input else "" base32Result = if isBase64 then "\nTrying base32:\n" ++ dec32 input else "" base16Result = if isBase16 then "\nTrying base16:\n" ++ dec16 input else "" base10Result = if isBase10 then "\nTrying base10:\n" ++ dec10 input else "" base2Result = if isBase2 then "\nTrying base2:\n" ++ dec2 input else "" base8Result = if isBase8 then "\nTrying base8:\n" ++ dec8 input else "" urlResult = if isURL then "\nTrying URL decode:\n" ++ decurl input else "" results = filter (not . null) [base91Result, base85Result, base64Result, base58Result, base32Result, base16Result, base10Result, base8Result, base2Result, urlResult] in if null results then "Not able to solve the encoding.\n" else unlines results -- -- | input =~ base64Regex = dec64 input -- | input =~ base32Regex = dec32 input -- | otherwise = "Cannot decode: " ++ input -- -- if BSU.fromString input =~ base64Regex :: Bool -- then dec64 input -- else "Not Base64.\n" -- ++ if BSU.fromString input =~ base32Regex :: Bool -- then dec32 input -- else "Not able to solve the encoding.\n" -- optionHandler :: EncodeOptions -> Text -> Text optionHandler Decode{b91=True} = dec91 optionHandler Encode{b91=True} = enc91 optionHandler Decode{b85=True} = dec85 optionHandler Encode{b85=True} = enc85 optionHandler Decode{b64=True} = dec64 optionHandler Encode{b64=True} = enc64 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{b58=True} = dec58 optionHandler Encode{b58=True} = enc58 optionHandler Decode{b32=True} = dec32 optionHandler Encode{b32=True} = enc32 optionHandler Decode{b16=True} = dec16 optionHandler Encode{b16=True} = enc16 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{qp=True} = decqp optionHandler Encode{qp=True} = encqp optionHandler Encode{uu=True} = encuu optionHandler Decode{uu=True} = decuu optionHandler Decode{xx=True} = decxx optionHandler Encode{xx=True} = encxx optionHandler Decode{yenc=True} = decy optionHandler Encode{yenc=True} = ency optionHandler Decode{solve=True} = solveEnc decodeMode :: Based decodeMode = Decode { b91 = def &= help "decode base91", b85 = def &= help "decode base85", b64 = def &= help "decode base64", b64url = def &= help "decode base64Url", url = def &= help "decode URI", b62 = def &= help "decode base62", b58 = def &= help "decode base58", 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", qp = def &= help "decode quoted-printable", uu = def &= help "decode uu", xx = def &= help "decode xx", yenc = def &= help "decode yEncode", solve = def &= help "solve encoding" } &= help "Decode chosen base" &=auto encodeMode :: Based encodeMode = Encode { b91 = def &= help "encode base91", b85 = def &= help "encode base85", b64 = def &= help "encode base64", b64url = def &= help "encode base64Url", url = def &= help "encode URI", b62 = def &= help "encode base62", b58 = def &= help "encode base58", 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", qp = def &= help "encode quoted-printable", uu = def &= help "encode uu", xx = def &= help "encode xx", yenc = def &= help "encode yEncode" } &= help "Encode chosen base" main :: IO() main = cmdArgs (modes[decodeMode, encodeMode] &= help "Anybased, when Cyberchef simply doesn't cut it.\nTo see every parameter of every mode use --help=all" &= program "based" &= summary "based v0.4") >>= interact . optionHandler