diff --git a/QC.hs b/QC.hs --- a/QC.hs +++ b/QC.hs @@ -59,7 +59,7 @@ prop_base64Encode ws = ws == (fromJust $ Base64.decode $ Base64.encode ws) where types = ws::[Word8] -prop_base64Chop s = s == (Base64.unchop $ Base64.chop 64 s) +prop_base64Chop s = s == (Base64.unchop $ Base64.chop 4 s) where types = s::String -- {{{1 base64url properties @@ -73,7 +73,7 @@ prop_base32Encode ws = ws == (fromJust $ Base32.decode $ Base32.encode ws) where types = ws::[Word8] -prop_base32Chop s = s == (Base32.unchop $ Base32.chop 64 s) +prop_base32Chop s = s == (Base32.unchop $ Base32.chop 8 s) where types = s::String -- {{{1 base32hex @@ -87,7 +87,7 @@ prop_base16Encode ws = ws == (fromJust $ Base16.decode $ Base16.encode ws) where types = ws::[Word8] -prop_base16Chop s = s == (Base16.unchop $ Base16.chop 16 s) +prop_base16Chop s = s == (Base16.unchop $ Base16.chop 6 s) where types = s::String -- {{{1 main diff --git a/UT.hs b/UT.hs --- a/UT.hs +++ b/UT.hs @@ -24,96 +24,133 @@ import System.Exit import Data.Maybe -import qualified Codec.Binary.Uu as Uu -import qualified Codec.Binary.Base64 as Base64 -import qualified Codec.Binary.Base64Url as Base64Url -import qualified Codec.Binary.Base32 as Base32 -import qualified Codec.Binary.Base32Hex as Base32Hex -import qualified Codec.Binary.Base16 as Base16 +import Codec.Binary.DataEncoding -- {{{1 buildTestList -- builds a list of successful tests based on a tuple (suite, description, --- encoded data, decoded data, encoding function, decoding function) +-- encoded data, decoded data, codec) buildTestList td = TestList $ concat - [ [TestLabel (suite ++ " encode " ++ desc) (enc ~=? (fenc dec)), TestLabel (suite ++ " decode " ++ desc) (dec ~=? (fromJust $ fdec enc))] - | (suite, desc, enc, dec, fenc, fdec) <- td ] + [[ TestLabel (suite ++ " encode " ++ desc) (enc ~=? (encode codec dec)) + , TestLabel (suite ++ " decode " ++ desc) (dec ~=? (fromJust $ decode codec $ enc))] + | (suite, desc, enc, dec, codec) <- td ] -- {{{1 uuencode tests uuTestData = - [ ("uu", "empty", "", [], Uu.encode, Uu.decode) - , ("uu", "\0", "``", [0], Uu.encode, Uu.decode) - , ("uu", "\255", "_P", [255], Uu.encode, Uu.decode) - , ("uu", "Example", "17AA;7!L90", [69,120,97,109,112,108,101], Uu.encode, Uu.decode) + [ ("uu", "empty", "", [], uu) + , ("uu", "\0", "``", [0], uu) + , ("uu", "\255", "_P", [255], uu) + , ("uu", "Example", "17AA;7!L90", [69,120,97,109,112,108,101], uu) ] uuTests = buildTestList uuTestData -uuTestData2 = - [("uu test5", "chop . encode Example", ["'17AA;7!L90"], [69,120,97,109,112,108,101], (Uu.chop 61 . Uu.encode), (Uu.decode . Uu.unchop)) +uuTests2 = test + [ "chop . encode Example" ~: ["'17AA;7!L90"] ~=? (chop uu 61 . encode uu) [69,120,97,109,112,108,101] + , "decode . unchop Example" ~: [69,120,97,109,112,108,101] ~=? fromJust ((decode uu . unchop uu) ["'17AA;7!L90"]) ] -uuTests2 = buildTestList uuTestData2 +uuTestsFail = test + [ "uu decode short" ~: Nothing ~=? decode uu "A" + , "uu decode' short" ~: [Nothing] ~=? decode' uu "A" + , "uu decode illegal" ~: Nothing ~=? decode uu "aa" + , "uu decode' illegal" ~: [Nothing] ~=? decode' uu "aa" + ] + -- {{{1 base64 tests base64TestData = - [ ("base64", "empty", "", [], Base64.encode, Base64.decode) - , ("base64", "f", "Zg==", [102], Base64.encode, Base64.decode) - , ("base64", "fo", "Zm8=", [102,111], Base64.encode, Base64.decode) - , ("base64", "foo", "Zm9v", [102,111,111], Base64.encode, Base64.decode) - , ("base64", "foob", "Zm9vYg==", [102,111,111,98], Base64.encode, Base64.decode) - , ("base64", "fooba", "Zm9vYmE=", [102,111,111,98,97], Base64.encode, Base64.decode) - , ("base64", "foobar", "Zm9vYmFy", [102,111,111,98,97,114], Base64.encode, Base64.decode) - , ("base64url", "\0", "AA==", [0], Base64.encode, Base64.decode) - , ("base64url", "\255", "/w==", [255], Base64.encode, Base64.decode) - , ("base64", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], Base64.encode, Base64.decode) + [ ("base64", "empty", "", [], base64) + , ("base64", "f", "Zg==", [102], base64) + , ("base64", "fo", "Zm8=", [102,111], base64) + , ("base64", "foo", "Zm9v", [102,111,111], base64) + , ("base64", "foob", "Zm9vYg==", [102,111,111,98], base64) + , ("base64", "fooba", "Zm9vYmE=", [102,111,111,98,97], base64) + , ("base64", "foobar", "Zm9vYmFy", [102,111,111,98,97,114], base64) + , ("base64url", "\0", "AA==", [0], base64) + , ("base64url", "\255", "/w==", [255], base64) + , ("base64", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64) ] base64Tests = buildTestList base64TestData +base64TestsFail = test + [ "base64 decode short" ~: Nothing ~=? decode base64 "A" + , "base64 decode' short" ~: [Nothing] ~=? decode' base64 "A" + , "base64 decode illegal" ~: Nothing ~=? decode base64 "!!" + , "base64 decode' illegal" ~: [Nothing] ~=? decode' base64 "!!" + ] + -- {{{1 base64url tests base64UrlTestData = - [ ("base64url", "empty", "", [], Base64Url.encode, Base64Url.decode) - , ("base64url", "\0", "AA==", [0], Base64Url.encode, Base64Url.decode) - , ("base64url", "\255", "_w==", [255], Base64Url.encode, Base64Url.decode) - , ("base64url", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], Base64Url.encode, Base64Url.decode) + [ ("base64url", "empty", "", [], base64Url) + , ("base64url", "\0", "AA==", [0], base64Url) + , ("base64url", "\255", "_w==", [255], base64Url) + , ("base64url", "Example", "RXhhbXBsZQ==", [69,120,97,109,112,108,101], base64Url) ] base64UrlTests = buildTestList base64UrlTestData -- {{{1 base32 tests base32TestData = - [ ("base32", "empty", "", [], Base32.encode, Base32.decode) - , ("base32", "f", "MY======", [102], Base32.encode, Base32.decode) - , ("base32", "fo", "MZXQ====", [102,111], Base32.encode, Base32.decode) - , ("base32", "foo", "MZXW6===", [102,111,111], Base32.encode, Base32.decode) - , ("base32", "foob", "MZXW6YQ=", [102,111,111,98], Base32.encode, Base32.decode) - , ("base32", "fooba", "MZXW6YTB", [102,111,111,98,97], Base32.encode, Base32.decode) - , ("base32", "foobar", "MZXW6YTBOI======", [102,111,111,98,97,114], Base32.encode, Base32.decode) + [ ("base32", "empty", "", [], base32) + , ("base32", "f", "MY======", [102], base32) + , ("base32", "fo", "MZXQ====", [102,111], base32) + , ("base32", "foo", "MZXW6===", [102,111,111], base32) + , ("base32", "foob", "MZXW6YQ=", [102,111,111,98], base32) + , ("base32", "fooba", "MZXW6YTB", [102,111,111,98,97], base32) + , ("base32", "foobar", "MZXW6YTBOI======", [102,111,111,98,97,114], base32) ] base32Tests = buildTestList base32TestData +base32TestsFail = test + [ "base32 decode short" ~: Nothing ~=? decode base32 "A" + , "base32 decode' short" ~: [Nothing] ~=? decode' base32 "A" + , "base32 decode illegal" ~: Nothing ~=? decode base32 "gh" + , "base32 decode' illegal" ~: [Nothing] ~=? decode' base32 "gh" + ] + -- {{{1 base32hex tests base32HexTestData = - [ ("base32hex", "empty", "", [], Base32Hex.encode, Base32Hex.decode) - , ("base32hex", "f", "CO======", [102], Base32Hex.encode, Base32Hex.decode) - , ("base32hex", "fo", "CPNG====", [102,111], Base32Hex.encode, Base32Hex.decode) - , ("base32hex", "foo", "CPNMU===", [102,111,111], Base32Hex.encode, Base32Hex.decode) - , ("base32hex", "foob", "CPNMUOG=", [102,111,111,98], Base32Hex.encode, Base32Hex.decode) - , ("base32hex", "fooba", "CPNMUOJ1", [102,111,111,98,97], Base32Hex.encode, Base32Hex.decode) - , ("base32hex", "foobar", "CPNMUOJ1E8======", [102,111,111,98,97,114], Base32Hex.encode, Base32Hex.decode) + [ ("base32hex", "empty", "", [], base32Hex) + , ("base32hex", "f", "CO======", [102], base32Hex) + , ("base32hex", "fo", "CPNG====", [102,111], base32Hex) + , ("base32hex", "foo", "CPNMU===", [102,111,111], base32Hex) + , ("base32hex", "foob", "CPNMUOG=", [102,111,111,98], base32Hex) + , ("base32hex", "fooba", "CPNMUOJ1", [102,111,111,98,97], base32Hex) + , ("base32hex", "foobar", "CPNMUOJ1E8======", [102,111,111,98,97,114], base32Hex) ] base32HexTests = buildTestList base32HexTestData +base32HexTestsFail = test + [ "base32hex decode short" ~: Nothing ~=? decode base32Hex "A" + , "base32hex decode' short" ~: [Nothing] ~=? decode' base32Hex "A" + , "base32hex decode illegal" ~: Nothing ~=? decode base32Hex "gh" + , "base32hex decode' illegal" ~: [Nothing] ~=? decode' base32Hex "gh" + ] + -- {{{1 base16 (hex) base16TestData = - [ ("base16", "empty", "", [], Base16.encode, Base16.decode) - , ("base16", "f", "66", [102], Base16.encode, Base16.decode) - , ("base16", "fo", "666F", [102,111], Base16.encode, Base16.decode) - , ("base16", "foo", "666F6F", [102,111,111], Base16.encode, Base16.decode) - , ("base16", "foob", "666F6F62", [102,111,111,98], Base16.encode, Base16.decode) - , ("base16", "fooba", "666F6F6261", [102,111,111,98,97], Base16.encode, Base16.decode) - , ("base16", "foobar", "666F6F626172", [102,111,111,98,97,114], Base16.encode, Base16.decode) + [ ("base16", "empty", "", [], base16) + , ("base16", "f", "66", [102], base16) + , ("base16", "fo", "666F", [102,111], base16) + , ("base16", "foo", "666F6F", [102,111,111], base16) + , ("base16", "foob", "666F6F62", [102,111,111,98], base16) + , ("base16", "fooba", "666F6F6261", [102,111,111,98,97], base16) + , ("base16", "foobar", "666F6F626172", [102,111,111,98,97,114], base16) ] base16Tests = buildTestList base16TestData +base16TestsFail = test + [ "base16 decode short" ~: Nothing ~=? decode base16 "A" + , "base16 decode' short" ~: [Nothing] ~=? decode' base16 "A" + , "base16 decode illegal" ~: Nothing ~=? decode base16 "GH" + , "base16 decode' illegal" ~: [Nothing] ~=? decode' base16 "GH" + ] + -- {{{1 test list and main -testList = TestList [uuTests, uuTests2, base64Tests, base64UrlTests, base32Tests, base32HexTests, base16Tests ] +testList = TestList + [ uuTests, uuTests2, uuTestsFail + , base64Tests, base64TestsFail + , base64UrlTests + , base32Tests, base32TestsFail + , base32HexTests, base32HexTestsFail + , base16Tests, base16TestsFail ] main :: IO () main = do diff --git a/dataenc.cabal b/dataenc.cabal --- a/dataenc.cabal +++ b/dataenc.cabal @@ -1,20 +1,32 @@ name: dataenc -version: 0.10.1 +version: 0.10.2 license: LGPL license-file: COPYING.LESSER +cabal-version: >= 1.2 author: Magnus Therning maintainer: magnus@therning.org copyright: Magnus Therning, 2007 -synopsis: Data encoding library currently providing Uuencode, Base64, - Base64Url, Base32, Base32Hex, and Base16. -hs-source-dirs: src +category: Codec +synopsis: Data encoding library +description: Data encoding library currently providing Uuencode, Base64, + Base64Url, Base32, Base32Hex, and Base16. extra-source-files: UT.hs QC.hs COPYING -build-depends: base -exposed-modules: - Codec.Binary.DataEncoding - Codec.Binary.Base16 - Codec.Binary.Base32Hex - Codec.Binary.Base32 - Codec.Binary.Uu - Codec.Binary.Base64Url - Codec.Binary.Base64 + +flag large_base + description: Choose the old larger, monolithic base package. + default: False + +library + hs-source-dirs: src + if flag(large_base) + build-depends: base + else + build-depends: array, base, containers + exposed-modules: + Codec.Binary.DataEncoding + Codec.Binary.Base16 + Codec.Binary.Base32Hex + Codec.Binary.Base32 + Codec.Binary.Uu + Codec.Binary.Base64Url + Codec.Binary.Base64 diff --git a/src/Codec/Binary/Base16.hs b/src/Codec/Binary/Base16.hs --- a/src/Codec/Binary/Base16.hs +++ b/src/Codec/Binary/Base16.hs @@ -85,7 +85,8 @@ -> [String] chop n "" = [] chop n s = let - enc_len = n `div` 2 * 2 + enc_len | n < 2 = 2 + | otherwise = n `div` 2 * 2 in (take enc_len s) : chop n (drop enc_len s) -- {{{1 unchop diff --git a/src/Codec/Binary/Base32.hs b/src/Codec/Binary/Base32.hs --- a/src/Codec/Binary/Base32.hs +++ b/src/Codec/Binary/Base32.hs @@ -146,7 +146,8 @@ -> [String] chop n "" = [] chop n s = let - enc_len = n `div` 8 * 8 + enc_len | n < 8 = 8 + | otherwise = n `div` 8 * 8 in (take enc_len s) : chop n (drop enc_len s) -- {{{1 unchop diff --git a/src/Codec/Binary/Base64.hs b/src/Codec/Binary/Base64.hs --- a/src/Codec/Binary/Base64.hs +++ b/src/Codec/Binary/Base64.hs @@ -130,7 +130,8 @@ -> [String] chop n "" = [] chop n s = let - enc_len = n `div` 4 * 4 + enc_len | n < 4 = 4 + | otherwise = n `div` 4 * 4 in (take enc_len s) : chop n (drop enc_len s) -- {{{1 unchop diff --git a/src/Codec/Binary/Uu.hs b/src/Codec/Binary/Uu.hs --- a/src/Codec/Binary/Uu.hs +++ b/src/Codec/Binary/Uu.hs @@ -133,7 +133,8 @@ -> [String] chop n "" = [] chop n s = let - enc_len = (n - 1) `div` 4 * 4 + enc_len | n < 5 = 4 + | otherwise = (n - 1) `div` 4 * 4 enc_line = take enc_len s act_len = fromIntegral $ case (length enc_line `divMod` 4) of (l, 0) -> l * 3