diff --git a/ChangeLog b/ChangeLog new file mode 100644 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,23 @@ +2013-12-01 Sam Truzjan + + * 0.2.1.0: Fixed build failure with base < 4.6.0. + +2013-11-29 Sam Truzjan + + * 0.2.0.1: Add tests to tarball. + +2013-11-29 Sam Truzjan + + * 0.2.0.0: Allow to catch decoding errors in pure code. + +2013-10-31 Sam Truzjan + + * 0.1.1.1: Update URLs after migration. + +2013-10-04 Sam Truzjan + + * 0.1.1.0: Added lenient decoding. + +2013-09-27 Sam Truzjan + + * 0.1.0.0: Initial version. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Sam Truzjan + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Sam Truzjan nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,27 @@ +`z-base32-bytestring` is an efficient [z-base32][rfc] codec for +bytestrings. The API is similar to the [base16-bytestring][base16-pkg] and +[base64-bytestring][base64-pkg] packages. + +### Performance + +| function | MB/sec | +|:---------------:|:---------------:| +|encoding | 400 | +|decoding | 400 | +|lenient decoding | 250 | + +### Maintainer Oscoin Engineering Team + +You can report any issues at [Issue tracker][issues]. + +### Credits + +The original package was created by Sam Truzjan , and the +human-oriented encoding support was added by the Oscoin Engineering Team. + +[base16-pkg]: http://hackage.haskell.org/package/base16-bytestring +[base64-pkg]: http://hackage.haskell.org/package/base64-bytestring-1.0.0.1 +[rfc]: https://philzimmermann.com/docs/human-oriented-base-32-encoding.txt +[travis-img]: https://travis-ci.org/pxqr/base32-bytestring.png +[travis-log]: https://travis-ci.org/pxqr/base32-bytestring +[issues]: https://github.com/pxqr/base32-bytestring/issues diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/base32-z-bytestring.cabal b/base32-z-bytestring.cabal new file mode 100644 --- /dev/null +++ b/base32-z-bytestring.cabal @@ -0,0 +1,72 @@ +name: base32-z-bytestring +version: 1.0.0.0 +license: BSD3 +license-file: LICENSE +author: Sam Truzjan, Oscoin Engineering Team +maintainer: Sam Truzjan +copyright: (c) 2013, Sam Truzjan, 2019 Oscoin Engineering Team +category: Codec, Data +build-type: Simple +cabal-version: >= 1.10 +homepage: https://github.com/oscoin/z-base32-bytestring +bug-reports: https://github.com/oscoin/z-base32-bytestring/issues +synopsis: Fast z-base32 and z-base32hex codec for ByteStrings +description: + base32 and base32hex codec according to RFC4648 + , extended to support z-base32 encoding + according to + . + The package API is similar to base64-bytestring. + +extra-source-files: README.md + , ChangeLog + +source-repository head + type: git + location: git://github.com/oscoin/z-base32-bytestring.git + branch: master + +source-repository this + type: git + location: git://github.com/oscoin/z-base32-bytestring.git + branch: master + tag: v0.2.1.0 + +library + default-language: Haskell2010 + default-extensions: + hs-source-dirs: src + exposed-modules: Data.ByteString.Base32.Z + other-modules: Data.ByteString.Base32.Internal + build-depends: base == 4.* + , bytestring >= 0.9 + , cpu == 0.1.* + ghc-options: -O2 -Wall + +test-suite tests + default-language: Haskell2010 + default-extensions: + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + other-modules: Test.Data.ByteString.Base32 + build-depends: base == 4.* + , z-base32-bytestring + , bytestring + , hedgehog + , tasty + , tasty-fail-fast + , tasty-hedgehog + , tasty-hspec + ghc-options: -Wall + +benchmark bench + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: bench + main-is: Main.hs + build-depends: base == 4.* + , z-base32-bytestring + , bytestring + , criterion + ghc-options: -O2 -Wall -fno-warn-orphans diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,39 @@ +module Main (main) where + +import Criterion.Main +import Data.ByteString as BS +import Data.ByteString.Base32 as Base32 +import Data.ByteString.Base32.Hex as Base32Hex + +main :: IO () +main = defaultMain + [ bench "base32/encode/1M" $ nf Base32.encode + $ BS.replicate 1000000 0x8e + , bench "base32/encode/5M" $ nf Base32.encode + $ BS.replicate 5000000 0x8e + + , bench "base32/decode/regular/1M" $ nf Base32.decode + $ BS.replicate 1000000 0x41 + , bench "base32/decode/regular/5M" $ nf Base32.decode + $ BS.replicate 5000000 0x41 + + , bench "base32/decode/lenient/1M" $ nf Base32.decodeLenient + $ BS.replicate 1000000 0x41 + , bench "base32/decode/lenient/5M" $ nf Base32.decodeLenient + $ BS.replicate 5000000 0x41 + + , bench "base32hex/encode/1M" $ nf Base32Hex.encode + $ BS.replicate 1000000 0x8e + , bench "base32hex/encode/5M" $ nf Base32Hex.encode + $ BS.replicate 5000000 0x8e + + , bench "base32hex/decode/regular/1M" $ nf Base32Hex.decode + $ BS.replicate 1000000 0x41 + , bench "base32hex/decode/regular/5M" $ nf Base32Hex.decode + $ BS.replicate 5000000 0x41 + + , bench "base32hex/decode/lenient/1M" $ nf Base32Hex.decodeLenient + $ BS.replicate 1000000 0x41 + , bench "base32hex/decode/lenient/5M" $ nf Base32Hex.decodeLenient + $ BS.replicate 5000000 0x41 + ] diff --git a/src/Data/ByteString/Base32/Internal.hs b/src/Data/ByteString/Base32/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Base32/Internal.hs @@ -0,0 +1,229 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : stable +-- Portability : portable +-- +-- (Word5 <-> Word8) and (Word8 -> Word5) bytestring packers using +-- lookup table. +-- +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +module Data.ByteString.Base32.Internal + ( Word5 + , Word8 + + , EncTable + , unpack5 + + , DecTable + , pack5 + , pack5Lenient + , invIx + ) where + +#if !MIN_VERSION_base(4,6,0) +import Prelude hiding (catch) +#endif +import Control.Exception hiding (mask) +import Data.ByteString as BS +import Data.ByteString.Internal as BS +import Data.Word +import Foreign +import System.Endian +import System.IO.Unsafe (unsafePerformIO) + +{----------------------------------------------------------------------- +-- Utils +-----------------------------------------------------------------------} + +type Word5 = Word8 + +{----------------------------------------------------------------------- +-- Encoding +-----------------------------------------------------------------------} + +unpack5Ptr :: Ptr Word8 -> ByteString -> ByteString +unpack5Ptr !tbl bs @ (PS fptr off sz) = + unsafePerformIO $ do + let unpackedSize = dstSize $ BS.length bs + BS.create unpackedSize $ \ dst -> do + withForeignPtr fptr $ \ ptr -> do + _dst_end <- bigStep dst (advancePtr ptr off) sz + return () + where + dstSize x = d + if m == 0 then 0 else 1 + where (d, m) = (x * 8) `quotRem` 5 + + bigStep !dst !src !s + | s >= 5 = do + unpack5_40 dst src + bigStep (dst `advancePtr` 8) (src `advancePtr` 5) (s - 5) + | otherwise = smallStep dst src s 0 0 + + unpack5_40 !dst !src = do + w32he <- peek (castPtr src) :: IO Word32 + let w32 = toBE32 w32he + fill8_32 0 (w32 `unsafeShiftR` 27) + fill8_32 1 (w32 `unsafeShiftR` 22) + fill8_32 2 (w32 `unsafeShiftR` 17) + fill8_32 3 (w32 `unsafeShiftR` 12) + fill8_32 4 (w32 `unsafeShiftR` 7) + fill8_32 5 (w32 `unsafeShiftR` 2) + + w8 <- peekElemOff src 4 + fill8_32 6 ( (w32 `unsafeShiftL` 3) + .|. fromIntegral (w8 `unsafeShiftR` 5)) + fill8_32 7 (fromIntegral w8) + where + fill8_32 :: Int -> Word32 -> IO () + fill8_32 !i !w32 = do + w8 <- peekByteOff tbl (fromIntegral w32 .&. 0x1f) + poke (dst `advancePtr` i) w8 + + smallStep !dst !src !s !unused !un_cnt + | un_cnt >= 5 = do + let ix = unused `unsafeShiftR` 3 + peekByteOff tbl (fromIntegral ix) >>= poke dst + smallStep (advancePtr dst 1) + src s + (unused `unsafeShiftL` 5) + (un_cnt - 5) + + | s == 0 = do + if un_cnt == 0 + then return dst + else do + let ix = unused `unsafeShiftR` 3 + peekByteOff tbl (fromIntegral ix) >>= poke dst + return (dst `advancePtr` 1) + + | otherwise = do + w8 <- peek src + let usd_cnt = 5 - un_cnt + let bits = w8 .&. complement (bit (8 - usd_cnt) - 1) + let ix = (unused .|. bits `shiftR` un_cnt) `unsafeShiftR` 3 + peekByteOff tbl (fromIntegral ix) >>= poke dst + smallStep (advancePtr dst 1) + (advancePtr src 1) (pred s) + (w8 `shiftL` usd_cnt) (8 - usd_cnt) + +type EncTable = ByteString + +unpack5 :: EncTable -> ByteString -> ByteString +unpack5 (PS fptr off len) bs + | len /= 32 + = error $ "base32: unpack5: invalid lookup table size " ++ show len + | otherwise = + unsafePerformIO $ do + withForeignPtr fptr $ \ptr -> do + return $ unpack5Ptr (ptr `advancePtr` off) bs + +{----------------------------------------------------------------------- +-- Decoding +-----------------------------------------------------------------------} + +invIx :: Word5 +invIx = 255 + +type Result = Either String + +cleanup :: IO a -> Result a +cleanup io = unsafePerformIO $ + catch (io >>= evaluate >>= return . Right) handler + where + handler (ErrorCall msg) = return (Left msg) + +pack5Ptr :: Ptr Word5 -> ByteString -> Result ByteString +pack5Ptr !tbl bs @ (PS fptr off sz) = + cleanup $ do + let packedSize = dstSize $ BS.length bs + BS.createAndTrim packedSize $ \ dst -> do + withForeignPtr fptr $ \ ptr -> do + dst_end <- bigStep dst (advancePtr ptr off) sz + return (dst_end `minusPtr` dst) + where + lookupTable :: Word8 -> Word5 + lookupTable ix + | x == invIx = error $ show (w2c ix) ++ " is not base32 character" + | otherwise = x + where x = unsafePerformIO (peekByteOff tbl (fromIntegral ix)) + {-# INLINE lookupTable #-} + + dstSize x = d + if m == 0 then 0 else 1 + where (d, m) = (x * 5) `quotRem` 8 + + bigStep !dst !src !s + | s > 8 = do + pack5_40 dst src + bigStep (dst `advancePtr` 5) (src `advancePtr` 8) (s - 8) + | otherwise = smallStep dst src s (0 :: Word64) 0 + + pack5_40 !dst !src = do + w64he <- peek (castPtr src) :: IO Word64 + let w64 = toBE64 w64he + let w40 = putAsW5 (w64 `unsafeShiftR` 00) $ + putAsW5 (w64 `unsafeShiftR` 08) $ + putAsW5 (w64 `unsafeShiftR` 16) $ + putAsW5 (w64 `unsafeShiftR` 24) $ + putAsW5 (w64 `unsafeShiftR` 32) $ + putAsW5 (w64 `unsafeShiftR` 40) $ + putAsW5 (w64 `unsafeShiftR` 48) $ + putAsW5 (w64 `unsafeShiftR` 56) 0 + pokeW40 w40 + where + putAsW5 :: Word64 -> Word64 -> Word64 + {-# INLINE putAsW5 #-} + putAsW5 !w8 !acc = (acc `unsafeShiftL` 5) + .|. fromIntegral (lookupTable (fromIntegral w8)) + + pokeW40 :: Word64 -> IO () + {-# INLINE pokeW40 #-} + pokeW40 !w40 = do + poke dst (fromIntegral (w40 `unsafeShiftR` 32) :: Word8) + poke (castPtr (dst `advancePtr` 1)) + (fromBE32 (fromIntegral w40 :: Word32)) + + smallStep !dst !src !s !unused !un_cnt + | un_cnt >= 8 = do + poke dst $ fromIntegral (unused `unsafeShiftR` (un_cnt - 8)) + smallStep (dst `advancePtr` 1) src s unused (un_cnt - 8) + + | s == 0 = return dst + | otherwise = do + w8 <- peek src + if w2c w8 == '=' + then if (bit un_cnt - 1) .&. unused == 0 + then smallStep dst src 0 0 0 + else smallStep dst src 0 (unused `shiftL` (8 - un_cnt)) 8 + else smallStep dst + (src `advancePtr` 1) (pred s) + ((unused `unsafeShiftL` 5) + .|. fromIntegral (lookupTable (fromIntegral w8))) + (un_cnt + 5) + +type DecTable = ByteString + +pack5 :: DecTable -> ByteString -> Result ByteString +pack5 (PS fptr off len) bs + | len /= 256 + = error $ "base32: pack5: invalid lookup table size " ++ show len + | otherwise = + unsafePerformIO $ do + withForeignPtr fptr $ \ptr -> + return $ pack5Ptr (ptr `advancePtr` off) bs + +{----------------------------------------------------------------------- +-- Lenient Decoding +-----------------------------------------------------------------------} + +isInAlphabet :: Ptr Word5 -> Word8 -> Bool +isInAlphabet !tbl !ix = + unsafePerformIO (peekByteOff tbl (fromIntegral ix)) /= invIx + +pack5Lenient :: DecTable -> ByteString -> Either String ByteString +pack5Lenient tbl @ (PS fptr _ _) bs = + unsafePerformIO $ do + withForeignPtr fptr $ \ !tbl_ptr -> do + return $! pack5 tbl $ BS.filter (isInAlphabet tbl_ptr) bs diff --git a/src/Data/ByteString/Base32/Z.hs b/src/Data/ByteString/Base32/Z.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Base32/Z.hs @@ -0,0 +1,81 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013, Oscoin Engineering Team 2019 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : stable +-- Portability : portable +-- +-- Efficient encoding and decoding of base32 encoded bytestring +-- according to RFC 4648. +-- +-- This module recommended to be imported as +-- @import Data.ByteString.Base32.Z as Base32@ to avoid name clashes +-- with @Data.Binary@ or @Data.ByteString.Base64@ modules. +-- +{-# LANGUAGE BangPatterns #-} +module Data.ByteString.Base32.Z + ( Base32 + , encode + , decode + , decodeLenient + + , encTable + , decTable + ) where + +import Data.ByteString as BS +import Data.ByteString.Base32.Internal +import qualified Data.ByteString.Char8 as C8 + + +-- | Base32 encoded bytestring. +type Base32 = ByteString + +encTable :: EncTable +encTable = C8.pack "ybndrfg8ejkmcpqxot1uwisza345h769" + +-- | Encode an arbitrary bytestring into (upper case) base32 form. +encode :: ByteString -> Base32 +encode = unpack5 encTable + + +-- Taken from . +decTable :: ByteString +decTable = BS.pack [ + invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, 18 + , invIx, 25, 26, 27, 30, 29, 7, 31, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, 24, 1, 12, 3, 8 + , 5, 6, 28, 21, 9, 10, invIx, 11, 2, 16 + , 13, 14, 4, 22, 17, 19, invIx, 20, 15, 0 + , 23, invIx, invIx, invIx, invIx, invIx, invIx, 24, 1, 12 + , 3, 8, 5, 6, 28, 21, 9, 10, invIx, 11 + , 2, 16, 13, 14, 4, 22, 17, 19, invIx, 20 + , 15, 0, 23, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx, invIx + , invIx, invIx, invIx, invIx, invIx, invIx + ] + +-- | Decode a base32 encoded bytestring. This functions is +-- case-insensitive and do not require correct padding. +decode :: Base32 -> Either String ByteString +decode = pack5 decTable + +-- | The same as 'decode' but with additional leniency: decodeLenient +-- will skip non-alphabet characters. +decodeLenient :: Base32 -> Either String ByteString +decodeLenient = pack5Lenient decTable diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,10 @@ +module Main (main) where + +import qualified Test.Data.ByteString.Base32 as Base32 +import Test.Tasty +import Test.Tasty.Ingredients.FailFast + +main :: IO () +main = do + defaultMainWithIngredients (map failFast defaultIngredients) $ testGroup "All" + [ Base32.tests ] diff --git a/test/Test/Data/ByteString/Base32.hs b/test/Test/Data/ByteString/Base32.hs new file mode 100644 --- /dev/null +++ b/test/Test/Data/ByteString/Base32.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE OverloadedStrings #-} +module Test.Data.ByteString.Base32 (tests) where + +import Data.ByteString.Base32.Z as Base32 +import Data.ByteString.Char8 as BC +import Data.Char + +import System.IO.Unsafe (unsafePerformIO) + +import Hedgehog +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range +import Test.Tasty +import Test.Tasty.Hedgehog +import Test.Tasty.Hspec + + +-- The use of 'unsafePerformIO' seems to be \"recommended\" by the library +-- itself: http://hackage.haskell.org/package/tasty-hspec-1.1.5.1/docs/Test-Tasty-Hspec.html#g:4 +-- gulp! +tests :: TestTree +tests = testGroup "Z-Base32" [ + unsafePerformIO $ testSpec "encode" encodeSpec + , unsafePerformIO $ testSpec "decode" decodeSpec + , unsafePerformIO $ testSpec "decodeLenient" decodeLenientSpec + , testProperty "encode roundtrips case sensitive" propEncodeRoundtrips + , testProperty "encode roundtrips case insensitive" propEncodeCaseInsensitiveRoundtrips + , testProperty "decode lenient roundtrips" propDecodeLenientRoundtrips + , testProperty "decode lenient roundtrips (case insensitive)" propDecodeLenientCaseInsensitiveRoundtrips + ] + +{------------------------------------------------------------------------------ +--- Specs +------------------------------------------------------------------------------} + +encodeSpec :: Spec +encodeSpec = + it "conform RFC examples" $ do + encode "" `shouldBe` "" + encode "f" `shouldBe` "ca" + encode "fo" `shouldBe` "c3zo" + encode "foo" `shouldBe` "c3zs6" + encode "foob" `shouldBe` "c3zs6ao" + encode "fooba" `shouldBe` "c3zs6aub" + encode "foobar" `shouldBe` "c3zs6aubqe" + +decodeSpec :: Spec +decodeSpec = do + it "conform RFC examples" $ do + decode "" `shouldBe` Right "" + decode "ca" `shouldBe` Right "f" + decode "c3zo" `shouldBe` Right "fo" + decode "c3zs6" `shouldBe` Right "foo" + decode "c3zs6ao" `shouldBe` Right "foob" + decode "c3zs6aub" `shouldBe` Right "fooba" + decode "c3zs6aubqe" `shouldBe` Right "foobar" + it "fail gracefully if encoded data contains non alphabet chars" $ do + decode "0=======" `shouldBe` Left "'0' is not base32 character" + decode "AAAAAAAA0=======" `shouldBe` Left "'0' is not base32 character" + +decodeLenientSpec :: Spec +decodeLenientSpec = do + it "conform RFC examples" $ do + decodeLenient "" `shouldBe` Right "" + decodeLenient "ca" `shouldBe` Right "f" + decodeLenient "c3zo" `shouldBe` Right "fo" + decodeLenient "c3zs6" `shouldBe` Right "foo" + decodeLenient "c3zs6ao" `shouldBe` Right "foob" + decodeLenient "c3zs6aub" `shouldBe` Right "fooba" + decodeLenient "c3zs6aubqe" `shouldBe` Right "foobar" + + it "skip non alphabet chars" $ do + decodeLenient "|" `shouldBe` Right "" + decodeLenient "M" `shouldBe` Right "" + decodeLenient "M|ca" `shouldBe` Right "[" + +{------------------------------------------------------------------------------ +--- Properties +------------------------------------------------------------------------------} + +propEncodeRoundtrips :: Property +propEncodeRoundtrips = property $ do + bs <- forAll $ Gen.bytes (Range.linear 0 500) + decode (encode bs) === Right bs + +propEncodeCaseInsensitiveRoundtrips :: Property +propEncodeCaseInsensitiveRoundtrips = property $ do + bs <- forAll $ Gen.utf8 (Range.linear 0 500) Gen.unicodeAll + decode (BC.map toLower (encode bs)) === Right bs + +propDecodeLenientRoundtrips :: Property +propDecodeLenientRoundtrips = property $ do + bs <- forAll $ Gen.bytes (Range.linear 0 500) + decodeLenient (encode bs) === Right bs + +propDecodeLenientCaseInsensitiveRoundtrips :: Property +propDecodeLenientCaseInsensitiveRoundtrips = property $ do + bs <- forAll $ Gen.utf8 (Range.linear 0 500) Gen.unicodeAll + decodeLenient (BC.map toLower (encode bs)) === Right bs