based/app/Main.hs

#!/usr/bin/env runhaskell

{-# LANGUAGE DeriveDataTypeable #-}

module Main where
import System.Console.CmdArgs 
import Control.Arrow
import Data.ByteString.UTF8 as BSU      -- from utf8-string
import qualified Data.ByteString.Char8 as C
import Text.Regex.TDFA
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.Base58          (enc58, dec58)
import Encoding.Base62          (enc62, dec62)
import Encoding.Base64          (enc64, dec64, enc64url, dec64url)
import Encoding.Base85          (enc85, dec85)
import Encoding.Base91          (enc91, dec91)
import Encoding.Url             (encurl, decurl)
import Encoding.Xx              (encxx, decxx)
import Encoding.QuotedPrintable (encqp, decqp)
import Encoding.UnixToUnix      (encuu, decuu)
import Encoding.Yenc            (ency, decy)
import Encoding.Rotate          (rotate)


data Based = Decode { 
              b91 :: Bool,
              b85 :: Bool,
              b64 :: Bool,
              b64url :: Bool,
              url :: Bool,
              b62 :: Bool,
              b58 :: Bool,
              b45 :: Bool,
              b32 :: Bool,
              b16 :: Bool,
              b10 :: Bool,
              b8  :: Bool,
              b2  :: Bool,
              qp  :: Bool,
              uu  :: Bool,
              xx  :: Bool,
              yenc :: Bool,
              rot :: Maybe Int,
              solve :: Bool
                    }
           | Encode { 
              b91 :: Bool,
              b85 :: Bool, 
              b64 :: Bool,
              b64url :: Bool,
              url :: Bool,
              b62 :: Bool,
              b58 :: Bool,
              b45 :: Bool,
              b32 :: Bool,
              b16 :: Bool,
              b10 :: Bool,
              b8  :: Bool,
              b2  :: Bool,
              qp  :: Bool,
              uu  :: Bool,
              xx  :: Bool,
              yenc :: Bool,
              rot :: Maybe Int
                    } 
             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

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

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{b45=True} = dec45
optionHandler Encode{b45=True} = enc45
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 Encode{rot=Just n} = rotate n
optionHandler Decode{rot=Just n} = rotate n
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",
            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",
            qp  = def &= help "decode quoted-printable",
            uu  = def &= help "decode uu",
            xx  = def &= help "decode xx",
            yenc = def &= help "decode yEncode",
            rot = def &= help "rotate characters by n positions",
            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",
            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",
            qp  = def &= help "encode quoted-printable",
            uu  = def &= help "encode uu",
            xx  = def &= help "encode xx",
            yenc = def &= help "encode yEncode",
            rot = def &= help "rotate characters by n positions" 
       } &= help "Encode chosen base"

main :: IO()
main = cmdArgs (modes[decodeMode, encodeMode] &= help "Based, when Cyberchef doesn't cut it.\nTo see every parameter of every mode use --help=all" &= program "based" &= summary "based v0.4") >>= interact . optionHandler