base32-z-bytestring (empty) → 1.0.0.0
raw patch · 10 files changed
+612/−0 lines, 10 filesdep +basedep +bytestringdep +cpusetup-changed
Dependencies added: base, bytestring, cpu, criterion, hedgehog, tasty, tasty-fail-fast, tasty-hedgehog, tasty-hspec, z-base32-bytestring
Files
- ChangeLog +23/−0
- LICENSE +30/−0
- README.md +27/−0
- Setup.hs +2/−0
- base32-z-bytestring.cabal +72/−0
- bench/Main.hs +39/−0
- src/Data/ByteString/Base32/Internal.hs +229/−0
- src/Data/ByteString/Base32/Z.hs +81/−0
- test/Main.hs +10/−0
- test/Test/Data/ByteString/Base32.hs +99/−0
+ ChangeLog view
@@ -0,0 +1,23 @@+2013-12-01 Sam Truzjan <pxqr.sta@gmail.com>++ * 0.2.1.0: Fixed build failure with base < 4.6.0.++2013-11-29 Sam Truzjan <pxqr.sta@gmail.com>++ * 0.2.0.1: Add tests to tarball.++2013-11-29 Sam Truzjan <pxqr.sta@gmail.com>++ * 0.2.0.0: Allow to catch decoding errors in pure code.++2013-10-31 Sam Truzjan <pxqr.sta@gmail.com>++ * 0.1.1.1: Update URLs after migration.++2013-10-04 Sam Truzjan <pxqr.sta@gmail.com>++ * 0.1.1.0: Added lenient decoding.++2013-09-27 Sam Truzjan <pxqr.sta@gmail.com>++ * 0.1.0.0: Initial version.
+ LICENSE view
@@ -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.
+ README.md view
@@ -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 <http://oscoin.io>++You can report any issues at [Issue tracker][issues].++### Credits++The original package was created by Sam Truzjan <pxqr.sta@gmail.com>, 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
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ base32-z-bytestring.cabal view
@@ -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 <pxqr.sta@gmail.com>+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+ <http://tools.ietf.org/html/rfc4648>, extended to support z-base32 encoding+ according to <https://gist.github.com/maaku/8996338#file-bip-ecc32-mediawiki>+ .+ 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
+ bench/Main.hs view
@@ -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+ ]
+ src/Data/ByteString/Base32/Internal.hs view
@@ -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
+ src/Data/ByteString/Base32/Z.hs view
@@ -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. <http://tools.ietf.org/html/rfc4648>+--+-- 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 <here https://gist.github.com/maaku/8996338#file-common-cpp-L14>.+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
+ test/Main.hs view
@@ -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 ]
+ test/Test/Data/ByteString/Base32.hs view
@@ -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