whx
/
based
1
0
Fork 0
Code Issues Pull Requests Projects Releases 9 Wiki Activity

Compare commits

base: whx:master
Branches Tags
whx:master
whx:v0.4.5
whx:v0.4.4
whx:v0.4.3
whx:v0.4.2
whx:v0.4.1
whx:v0.4
whx:v0.3
whx:v0.2
whx:v0.1.1
whx:v0.1
..
compare: whx:v0.4.4
Branches Tags
whx:master
whx:v0.4.5
whx:v0.4.4
whx:v0.4.3
whx:v0.4.2
whx:v0.4.1
whx:v0.4
whx:v0.3
whx:v0.2
whx:v0.1.1
whx:v0.1

No commits in common. "master" and "v0.4.4" have entirely different histories.
master ... v0.4.4

10 changed files with 44 additions and 286 deletions
Show Stats Expand all files Collapse all files

8
CHANGELOG.md
View File

@ -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

67
app/Main.hs
View File

@ -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
@ -111,16 +138,10 @@ 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{a1z26=True} = decltn
optionHandler Encode{a1z26=True} = encltn
optionHandler Decode{rot=Just n} = rotate n
optionHandler Decode{yenc=True} = decy
optionHandler Encode{yenc=True} = ency
optionHandler Encode{rot=Just n} = rotate n
optionHandler Decode{morse=True} = decmorse
optionHandler Encode{morse=True} = encmorse
optionHandler Decode{tap=True} = dectap
optionHandler Encode{tap=True} = enctap
optionHandler Decode{rot=Just n} = rotate n
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",
morse = def &= help "encode morse",
tap = def &= help "encode tap code using a Polybius square (5x5 grid Latin alphabet)"
rot = def &= help "rotate characters by n positions"
} &= help "Encode chosen base"
main :: IO()

12
based.cabal
View File

@ -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,
containers,
split,
MorseCode
base64-bytestring
default-language: Haskell2010
executable based

1
src/Encoding/Base2.hs
View File

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

30
src/Encoding/LetterToNumber.hs
View File

@ -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

21
src/Encoding/Morse.hs
View File

@ -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

58
src/Encoding/Solve.hs
View File

@ -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]

47
src/Encoding/Tap.hs
View File

@ -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

63
src/Encoding/Unary.hs
View File

@ -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

23
test/Main.hs
View File

@ -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 ency" testEncYenc,
TestLabel "Test rot" testRotate]
TestLabel "Test encuu" testEncXx]
-- main :: IO Counts