243 lines
9.3 KiB
Haskell
243 lines
9.3 KiB
Haskell
#!/usr/bin/env runhaskell
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
|
|
module Main where
|
|
import System.Console.CmdArgs
|
|
import Control.Arrow
|
|
import Data.Text (pack, unpack)
|
|
import Data.Text.Encoding (encodeUtf8)
|
|
import Data.Maybe (fromJust)
|
|
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 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 qualified Data.ByteString.Char8 as C
|
|
|
|
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
|
|
}
|
|
| 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 :: C.ByteString -> Either String BS.ByteString
|
|
-- decodeToBase91 decoded =
|
|
-- case B91.decode of
|
|
-- Just bs -> Right decoded
|
|
-- Nothing -> Left "Failed to decode from Base91."
|
|
|
|
|
|
-- encodeToBase64 :: C.ByteString -> Either String BS.ByteString
|
|
-- encodeToBase64 bs =
|
|
-- case B64.encode bs of
|
|
-- encoded | BS.null encoded -> Left "Failed to encode base64."
|
|
-- | 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."
|
|
| 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 = C.unpack . B91.decode
|
|
-- dec91 :: C.ByteString -> Either String String
|
|
-- dec91 input = do
|
|
-- decoded <- decodeFromBase91 input
|
|
-- -- return $ C.unpack decoded
|
|
-- -- is the same as
|
|
-- return (C.unpack decoded)
|
|
|
|
enc91 = B91.encode . BSU.fromString
|
|
dec85 = C.unpack . U.fromRight . B85.decode . BSU.fromString
|
|
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 -> Either String String
|
|
-- enc64 input = do
|
|
-- byteString <- convertToByteString input
|
|
-- encoded <- encodeToBase64 byteString
|
|
-- return $ BS.unpack encoded
|
|
|
|
dec64url = C.unpack . U.fromRight . B64U.decode . BSU.fromString
|
|
enc64url = C.unpack . B64U.encode . BSU.fromString
|
|
decurl = HB.urlDecode
|
|
encurl = HB.urlEncode
|
|
dec62 = show . fromJust . B62.decode128 . (Bytes.fromByteString . BSU.fromString)
|
|
enc62 = C.unpack . BSU.fromString. Bytes.toLatinString . (Bytes.fromByteArray . ( B62.encode64 . (intToWord64 . decimalStringToInt)))
|
|
dec58 = C.unpack . fromJust . B58.decodeBase58 . pack
|
|
enc58 = unpack . B58.encodeBase58 . BSU.fromString
|
|
dec32 = C.unpack . U.fromRight . B32.decode . BSU.fromString
|
|
enc32 = C.unpack . B32.encode . BSU.fromString
|
|
dec16 = C.unpack . U.fromRight . B16.decode . BSU.fromString
|
|
enc16 = C.unpack . B16.encode . BSU.fromString
|
|
dec10 = show . hexStringToInt
|
|
enc10 = C.unpack . BSU.fromString . intToHexString . decimalStringToInt -- Depending on what you want, do enc10 = show . map ord
|
|
dec8 = C.unpack . encodeUtf8 . toText . showbOct . hexStringToInt
|
|
enc8 = C.unpack . BSU.fromString . intToHexString . octToInt . (reverse . (map fromJust . (map fromOctDigit)))
|
|
dec2 = C.unpack . encodeUtf8 . toText . showbBin . hexStringToInt
|
|
enc2 = C.unpack . BSU.fromString . intToHexString . binToInt . (reverse . (map fromJust . (map fromBinDigit)))
|
|
decqp = C.unpack . U.fromRight . QP.decode . BSU.fromString
|
|
encqp = C.unpack . QP.encode . BSU.fromString
|
|
decuu = C.unpack . U.fromRight . UU.decode . BSU.fromString
|
|
encuu = C.unpack . UU.encode . BSU.fromString
|
|
decxx = C.unpack . U.fromRight . XX.decode . BSU.fromString
|
|
encxx = C.unpack . XX.encode . BSU.fromString
|
|
decy = C.unpack . U.fromRight . Y.decode . BSU.fromString
|
|
ency = C.unpack . Y.encode . BSU.fromString
|
|
|
|
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} = decuu
|
|
optionHandler Decode{uu=True} = encuu
|
|
optionHandler Decode{xx=True} = decxx
|
|
optionHandler Encode{xx=True} = encxx
|
|
optionHandler Decode{yenc=True} = decy
|
|
optionHandler Encode{yenc=True} = ency
|
|
|
|
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"
|
|
} &= 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
|