CHANGELOG.md

@@ -1,13 +1,5 @@
 Revision history for based
 
-0.4.5.0 -- 2024-09-25
-
-    Added tap code
-    Removed some bugs of the solve functions
-    Added bindings for morse code, bug fix
-    Simplified functions, ignore non ascii characters
-    Added test for rotate function and yencode/decode
-
 0.4.4.0 -- 2024-06-09
 
     Added tests for every encode function included

app/Main.hs

@@ -5,6 +5,8 @@
 module Main where
 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.Base8           (enc8, dec8)
 import Encoding.Base10          (enc10, dec10)
@@ -21,11 +23,7 @@ import Encoding.Xx              (encxx, decxx)
 import Encoding.QuotedPrintable (encqp, decqp)
 import Encoding.UnixToUnix      (encuu, decuu)
 import Encoding.Yenc            (ency, decy)
-import Encoding.LetterToNumber  (encltn, decltn)
 import Encoding.Rotate          (rotate)
-import Encoding.Morse           (encmorse, decmorse)
-import Encoding.Tap             (enctap, dectap)
-import Encoding.Solve           (solveEnc)
 
 
 data Based = Decode { 
@@ -46,10 +44,7 @@ data Based = Decode {
              uu  :: Bool,
              xx  :: Bool,
              yenc :: Bool,
-             a1z26 :: Bool,
              rot :: Maybe Int,
-             morse :: Bool,
-             tap :: Bool,
              solve :: Bool
                    }
           | Encode { 
@@ -70,13 +65,45 @@ data Based = Decode {
              uu  :: Bool,
              xx  :: Bool,
              yenc :: Bool,
-             a1z26 :: Bool,
-             morse :: Bool,
-             tap :: Bool,
              rot :: Maybe Int
                    } 
             deriving(Show, Data, Typeable) 
 
+base91Regex = "^[!-~]*$"
+base85Regex = "^[0-9A-Za-z!#$%&()*+,-;<=>?@^_`{|}~]+$"
+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 :: BC.ByteString -> BC.ByteString
+solveEnc input =
+   let isBase91 = input =~ base91Regex :: Bool
+       isBase85 = input =~ base85Regex :: Bool
+       isBase64 = input =~ base64Regex :: Bool
+       isBase58 = input =~ base58Regex :: Bool
+       isBase32 = input =~ base32Regex :: Bool
+       isBase16 = input =~ base16Regex :: Bool
+       isBase10 = input =~ base10Regex :: Bool
+       isBase8  = input =~ base8Regex  :: Bool
+       isBase2  = input =~ base2Regex  :: Bool
+       isURL = input =~ urlRegex :: Bool
+       base91Result = if isBase91 then BC.pack "\nTrying base91:\n" `BC.append` dec91 input else BC.empty
+       base85Result = if isBase85 then BC.pack "\nTrying base85:\n" `BC.append` dec85 input else BC.empty
+       base64Result = if isBase64 then BC.pack "\nTrying base64:\n" `BC.append` dec64 input else BC.empty
+       base58Result = if isBase58 then BC.pack "\nTrying base58:\n" `BC.append` dec58 input else BC.empty
+       base32Result = if isBase64 then BC.pack "\nTrying base32:\n" `BC.append` dec32 input else BC.empty
+       base16Result = if isBase16 then BC.pack "\nTrying base16:\n" `BC.append` dec16 input else BC.empty
+       base10Result = if isBase10 then BC.pack "\nTrying base10:\n" `BC.append` dec10 input else BC.empty
+       base2Result  = if isBase2  then BC.pack "\nTrying base2:\n"  `BC.append` dec2  input else BC.empty
+       base8Result  = if isBase8  then BC.pack "\nTrying base8:\n"  `BC.append` dec8  input else BC.empty
+       urlResult    = if isURL    then BC.pack "\nTrying URL decode:\n" `BC.append` decurl input else BC.empty
+   in BC.concat [base91Result, base85Result, base64Result, base58Result, base32Result, base16Result, base10Result, base8Result, base2Result,  urlResult]
+
 
 optionHandler :: Based ->  B.ByteString -> B.ByteString
 optionHandler Decode{b91=True} = dec91
@@ -113,14 +140,8 @@ optionHandler Decode{xx=True}  = decxx
 optionHandler Encode{xx=True}  = encxx
 optionHandler Decode{yenc=True}   = decy
 optionHandler Encode{yenc=True}   = ency
-optionHandler Decode{a1z26=True} = decltn
-optionHandler Encode{a1z26=True} = encltn
-optionHandler Decode{rot=Just n} = rotate n
 optionHandler Encode{rot=Just n} = rotate n
-optionHandler Decode{morse=True} = decmorse
+optionHandler Decode{rot=Just n} = rotate n
-optionHandler Encode{morse=True} = encmorse
-optionHandler Decode{tap=True} = dectap
-optionHandler Encode{tap=True} = enctap
 optionHandler Decode{solve=True} = solveEnc
 
 decodeMode :: Based
@@ -142,10 +163,7 @@ decodeMode = Decode {
            uu  = def &= help "decode UnixToUnix",
            xx  = def &= help "decode xx, without padding",
            yenc = def &= help "decode yEncode",
-           a1z26 = def &= help "decode letter to number",
            rot = def &= help "rotate characters by n positions",
-           morse = def &= help "decode morse",
-           tap = def &= help "decode tap code using a Polybius square (5x5 grid Latin alphabet)",
            solve = def &= help "solve encoding"
        }  &= help "Decode chosen base" &=auto
 
@@ -168,10 +186,7 @@ encodeMode = Encode {
            uu  = def &= help "encode UnixToUnix",
            xx  = def &= help "encode xx, without padding",
            yenc = def &= help "encode yEncode",
-           a1z26 = def &= help "encode letter to number",
+           rot = def &= help "rotate characters by n positions" 
-           rot = def &= help "rotate characters by n positions",
-           morse = def &= help "encode morse",
-           tap = def &= help "encode tap code using a Polybius square (5x5 grid Latin alphabet)"
       } &= help "Encode chosen base"
 
 main :: IO()

based.cabal

@@ -1,6 +1,6 @@
 cabal-version:       2.4
 name:                based
-version:             0.4.5.0
+version:             0.4.4.0
 license-file:        LICENSE
 extra-source-files:  CHANGELOG.md
 author: Stefan Friese
@@ -25,10 +25,6 @@ library
     Encoding.Xx
     Encoding.Yenc
     Encoding.Rotate
-    Encoding.LetterToNumber
-    Encoding.Morse
-    Encoding.Tap
-    Encoding.Solve
   other-modules:
     -- Data.Bytes.Text.Ascii
   build-depends:
@@ -46,11 +42,7 @@ library
     haskoin-core,
     text,
     primitive,
-    regex-tdfa,
+    base64-bytestring
-    base64-bytestring,
-    containers,
-    split,
-    MorseCode
   default-language:    Haskell2010
 
 executable based

src/Encoding/Base2.hs

@@ -31,7 +31,6 @@
 module Encoding.Base2
   ( enc2
   , dec2
-  , binaryToChar
   ) where
 
 import Data.Char (ord, chr, digitToInt, intToDigit)

src/Encoding/LetterToNumber.hs

@@ -1,30 +0,0 @@
-
-module Encoding.LetterToNumber
-  ( encltn
-  , decltn
-  ) where 
-
-import Data.Char (ord, chr, isAscii, isAlpha, isSpace, isDigit, toUpper)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as BC
-
--- This encodes ASCII characters only and ignores all other characters
-
-charToNumber :: Char -> ByteString
-charToNumber c
-  | not (isAscii c) = BC.pack ""
-  | isAlpha c = BC.pack $ show $ ord (toUpper c) - ord 'A' + 1
-  | isSpace c = BC.pack "0"
-  | otherwise = BC.singleton c
-
-numberToChar :: ByteString -> ByteString
-numberToChar s
-  | s == BC.pack "0" = BC.singleton ' '
-  | BC.all isDigit s = BC.singleton $ chr $ (read $ BC.unpack s) + ord 'A' - 1
-  | otherwise = s
-
-encltn :: ByteString -> ByteString
-encltn input = BC.unwords $ filter (not . BC.null) $ map charToNumber $ BC.unpack input
-
-decltn :: ByteString -> ByteString
-decltn input = BC.concat $ map numberToChar $ BC.words input

src/Encoding/Morse.hs

@@ -1,21 +0,0 @@
-module Encoding.Morse 
-  ( encmorse
-  , decmorse
-  ) where
-
-import Text.Morse as M
-import Data.ByteString (ByteString)
-import Data.Char (isSpace)
-import qualified Data.ByteString.Char8 as BC
-
-encmorse :: ByteString -> ByteString
-encmorse input = BC.pack $ encodeValidMorseChars (BC.unpack input)
-  where
-    encodeValidMorseChars :: String -> String
-    encodeValidMorseChars = concatMap (\c ->  M.encodeMorse [c])
-
-decmorse :: ByteString -> ByteString
-decmorse input = case M.decodeMorse (BC.unpack input) of
-                   "" -> BC.pack "Invalid Morse Code"
-                   decoded -> BC.pack decoded
-

src/Encoding/Solve.hs

@@ -1,58 +0,0 @@
-module Encoding.Solve
-  (solveEnc) where
-
-import qualified Data.ByteString.Char8 as BC
-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)
-
-
-base91Regex = "^[!-~]*$"
-base85Regex = "^[0-9A-Za-z!#$%&()*+,-;<=>?@^_`{|}~]+$"
-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 :: BC.ByteString -> BC.ByteString
-solveEnc input =
-   let isBase91 = input =~ base91Regex :: Bool
-       isBase85 = input =~ base85Regex :: Bool
-       isBase64 = input =~ base64Regex :: Bool
-       isBase58 = input =~ base58Regex :: Bool
-       isBase32 = input =~ base32Regex :: Bool
-       isBase16 = input =~ base16Regex :: Bool
-       isBase10 = input =~ base10Regex :: Bool
-       isBase8  = input =~ base8Regex  :: Bool
-       isBase2  = input =~ base2Regex  :: Bool
-       isURL = input =~ urlRegex :: Bool
-       base91Result = if isBase91 then BC.pack "\nBase91:\n" `BC.append` dec91 input else BC.empty
-       base85Result = if isBase85 then BC.pack "\nBase85:\n" `BC.append` dec85 input else BC.empty
-       base64Result = if isBase64 then BC.pack "\nBase64:\n" `BC.append` dec64 input else BC.empty
-       base58Result = if isBase58 then BC.pack "\nBase58:\n" `BC.append` dec58 input else BC.empty
-       base32Result = if isBase64 then BC.pack "\nBase32:\n" `BC.append` dec32 input else BC.empty
-       base16Result = if isBase16 then BC.pack "\nBase16:\n" `BC.append` dec16 input else BC.empty
-       base10Result = if isBase10 then BC.pack "\nBase10:\n" `BC.append` dec10 input else BC.empty
-       base2Result  = if isBase2  then BC.pack "\nBase2:\n"  `BC.append` dec2  input else BC.empty
-       base8Result  = if isBase8  then BC.pack "\nBase8:\n"  `BC.append` dec8  input else BC.empty
-       urlResult    = if isURL    then BC.pack "\nTrying URL decode:\n" `BC.append` decurl input else BC.empty
-   in BC.concat [base91Result, base85Result, base64Result, base58Result, base32Result, base16Result, base10Result, base8Result, base2Result,  urlResult]

src/Encoding/Tap.hs

@@ -1,47 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Encoding.Tap
-  ( enctap
-  , dectap
-  ) where
-
-import Data.Char (isAsciiUpper, isAsciiLower, toLower, chr, ord, toUpper)
-import Data.List (find)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString.Char8 as BC
-
-enctap :: ByteString -> ByteString
-enctap = BC.concatMap encodeChar
-  where
-    encodeChar ' ' = BC.singleton ' '
-    encodeChar 'K' = BC.pack "22"  -- Special case: 'K' is encoded as "22"
-    encodeChar c
-      | isAsciiUpper c || isAsciiLower c =
-          let (row, col) = positionInGrid c
-          in BC.pack [chr (ord '0' + row), chr (ord '0' + col)]
-      | otherwise = BC.empty  -- Handle non-alphabet characters or errors
-    
-    positionInGrid c =
-      let idx = ord (toUpper c) - ord 'A'
-          row = idx `div` 5 + 1
-          col = idx `mod` 5 + 1
-      in (row, col)
-
-dectap :: ByteString -> ByteString
-dectap = BC.concat . map decodePair . chunkPairs . BC.filter (/= ' ')
-  where
-    chunkPairs :: ByteString -> [ByteString]
-    chunkPairs bs
-      | BC.null bs = []
-      | otherwise = let (pair, rest) = BC.splitAt 2 bs in pair : chunkPairs rest
-
-    decodePair pair
-      | pair == "22" = BC.singleton 'K'  -- Special case: "22" is decoded as 'K'
-      | BC.length pair == 2 =
-          let [row, col] = BC.unpack pair
-              rowIdx = ord row - ord '0'
-              colIdx = ord col - ord '0'
-              idx = (rowIdx - 1) * 5 + (colIdx - 1)
-          in BC.singleton $ chr (ord 'A' + idx)
-      | otherwise = error $ "Invalid Tap Code sequence: " ++ show pair
-

src/Encoding/Unary.hs

@@ -1,63 +0,0 @@
-module Encoding.Unary
-  ( encunary
-  , decunary
-  ) where
-
-import Data.ByteString (ByteString)
-import Data.List (group)
-import qualified Data.ByteString.Char8 as BC
-import Encoding.Base2 (dec2, enc2, binaryToChar)
-import Debug.Trace (trace)
-
-encodeChuckNorris :: ByteString -> ByteString
-encodeChuckNorris binary = 
-  let cleanBinary = BC.filter (/= ' ') binary
-   in BC.unwords . concatMap encodeRunLength . group $ BC.unpack cleanBinary
-  where
-    encodeRunLength :: String -> [ByteString]
-    encodeRunLength xs@(x:_) = [prefix x, BC.pack (replicate (length xs) '0')]
-    encodeRunLength [] = []
-
-    prefix '0' = BC.pack "00"
-    prefix '1' = BC.pack "0"
-    prefix  c  = error $ "Invalid binary character encoding" ++ show c
-    
-pairs :: [a] -> [(a, a)]
-pairs (x:y:rest) = (x, y) : pairs rest
-pairs _ = []
-
-encunary :: ByteString -> ByteString
-encunary input = encodeChuckNorris $ enc2 input
-
-decodeChuckNorris :: ByteString -> ByteString
-decodeChuckNorris encoded = BC.pack . concatMap (BC.unpack . decodeRunLength) . pairs . BC.words $ encoded
-  where
-    decodeRunLength :: (ByteString, ByteString) -> ByteString
-    decodeRunLength (prefix, zeros)
-      | prefix == BC.pack "00" = BC.replicate (BC.length zeros) '0'
-      | prefix == BC.pack "0" = BC.replicate (BC.length zeros) '1'
-      | otherwise = error "Invalid Unary encoding"
-    -- pairs (x:y:rest) = (x, y) : pairs rest
-    -- pairs _ = []
-
-    -- decodeRunLength ("00", zeros) = replicate (BC.length zeros) '0'
-    -- decodeRunLength ("0", zeros) = replicate (BC.length zeros) '1'
-    -- decodeRunLength _ = error "Invalid Unary encoding"
-
-decunary :: ByteString -> ByteString
-decunary encoded =
-  let binaryStr = decodeChuckNorris encoded
-  in BC.pack $ map binaryToChar (chunkBinaryString binaryStr)
-  where
-    chunkBinaryString :: ByteString -> [ByteString]
-    chunkBinaryString bs
-      | BC.null bs = []
-      | otherwise  = let (chunk, rest) = BC.splitAt 8 bs
-                     in chunk : chunkBinaryString rest
-
--- encunary input = 
---   let binaryStr = enc2 input
---    in trace (show binaryStr) $ encodeChuckNorris binaryStr
-
--- decunary :: ByteString -> ByteString
--- decunary encoded = dec2 $ decodeChuckNorris encoded

test/Main.hs

@@ -17,8 +17,6 @@ import Encoding.Base2  (enc2,  dec2)
 import Encoding.QuotedPrintable (encqp, decqp)
 import Encoding.UnixToUnix      (encuu, decuu)
 import Encoding.Xx     (encxx, decxx)
-import Encoding.Yenc   (ency,  decy)
-import Encoding.Rotate (rotate)
 import System.Exit (exitFailure, exitSuccess)
 
 helloWorldBS :: B.ByteString
@@ -220,23 +218,6 @@ testDecXx = TestCase $ do
     assertEqual "for (decxx \"NaxjMa3m\")," (BSU.fromString "foobar") (decxx $ BSU.fromString "NaxjMa3m")
     assertEqual "for (decxx \"w7yMUU\")," (BSU.fromString "😂") (decxx $ BSU.fromString "w7yMUU")
 
-testEncYenc :: Test
-testEncYenc = TestCase $ do
-    assertEqual "for (ency \"Hello, World!\")," (B.pack [114, 143, 150, 150, 153, 86, 74, 129, 153, 156, 150, 142, 75]) (ency helloWorldBS)
-    assertEqual "for (ency \"😂\")," (B.pack [26, 201, 194, 172] ) (ency emojiBS)
-
-testDecYenc:: Test
-testDecYenc= TestCase $ do
-    assertEqual "for (decy \"r<8f><96><96><99>VJ<81><99><9c><96><8e>K\")," helloWorldBS (decy $ B.pack [114, 143, 150, 150, 153, 86, 74, 129, 153, 156, 150, 142, 75] )
-    assertEqual "for (decy \"^Z<c9>¬\")," (BSU.fromString "😂") (decy $ B.pack [26, 201, 194, 172])
-
-testRotate :: Test
-testRotate = TestCase $ do
-    assertEqual "for (rotate 13 \"Hello, World!\")," (BSU.fromString "Uryyb, Jbeyq!") (rotate 13 (BSU.fromString "Hello, World!"))
-    assertEqual "for (rotate 8 \"Hello, World!\")," (BSU.fromString "Pmttw, Ewztl!") (rotate 8 (BSU.fromString "Hello, World!"))
-    assertEqual "for (rotate 2 \"😂\")," (BSU.fromString "😂") (rotate 2 (BSU.fromString "😂"))
-
-
 tests :: Test
 tests = TestList [TestLabel "Test enc91" testEnc91,
                   TestLabel "Test dec91" testDec91,
@@ -267,9 +248,7 @@ tests = TestList [TestLabel "Test enc91" testEnc91,
                   TestLabel "Test decuu" testDecUu,
                   TestLabel "Test encuu" testEncUu,
                   TestLabel "Test decuu" testDecXx,
-                  TestLabel "Test encuu" testEncXx,
+                  TestLabel "Test encuu" testEncXx]
-                  TestLabel "Test ency"  testEncYenc,
-                  TestLabel "Test rot"   testRotate]
 
 
 -- main :: IO Counts