base16 0.2.1.0 → 0.3.0.0
raw patch · 17 files changed
+1012/−472 lines, 17 filesdep +QuickCheckdep +tasty-quickcheckdep −memorydep ~basedep ~bytestringdep ~deepseqPVP ok
version bump matches the API change (PVP)
Dependencies added: QuickCheck, tasty-quickcheck
Dependencies removed: memory
Dependency ranges changed: base, bytestring, deepseq, primitive, text-short
API changes (from Hackage documentation)
+ Data.Text.Encoding.Base16.Error: instance Control.DeepSeq.NFData e => Control.DeepSeq.NFData (Data.Text.Encoding.Base16.Error.Base16Error e)
+ Data.Text.Encoding.Base16.Error: instance GHC.Exception.Type.Exception e => GHC.Exception.Type.Exception (Data.Text.Encoding.Base16.Error.Base16Error e)
+ Data.Text.Encoding.Base16.Error: instance GHC.Generics.Generic (Data.Text.Encoding.Base16.Error.Base16Error e)
- Data.ByteString.Short.Base16: encodeBase16 :: ShortByteString -> Text
+ Data.ByteString.Short.Base16: encodeBase16 :: ShortByteString -> ShortText
- Data.Text.Encoding.Base16: decodeBase16With :: (ByteString -> Either err Text) -> Text -> Either (Base16Error err) Text
+ Data.Text.Encoding.Base16: decodeBase16With :: (ByteString -> Either err Text) -> ByteString -> Either (Base16Error err) Text
- Data.Text.Lazy.Encoding.Base16: decodeBase16With :: (ByteString -> Either err Text) -> Text -> Either (Base16Error err) Text
+ Data.Text.Lazy.Encoding.Base16: decodeBase16With :: (ByteString -> Either err Text) -> ByteString -> Either (Base16Error err) Text
- Data.Text.Short.Encoding.Base16: decodeBase16With :: (ShortByteString -> Either err ShortText) -> ShortText -> Either (Base16Error err) ShortText
+ Data.Text.Short.Encoding.Base16: decodeBase16With :: (ShortByteString -> Either err ShortText) -> ShortByteString -> Either (Base16Error err) ShortText
Files
- CHANGELOG.md +14/−0
- README.md +1/−1
- base16.cabal +28/−20
- benchmarks/Base16Bench.hs +28/−34
- src/Data/ByteString/Base16.hs +38/−25
- src/Data/ByteString/Base16/Internal/Head.hs +58/−7
- src/Data/ByteString/Base16/Internal/Utils.hs +33/−0
- src/Data/ByteString/Base16/Internal/W16/ShortLoop.hs +105/−0
- src/Data/ByteString/Lazy/Base16.hs +39/−24
- src/Data/ByteString/Short/Base16.hs +51/−34
- src/Data/Text/Encoding/Base16.hs +41/−28
- src/Data/Text/Encoding/Base16/Error.hs +32/−7
- src/Data/Text/Lazy/Encoding/Base16.hs +42/−30
- src/Data/Text/Short/Encoding/Base16.hs +54/−37
- test/Base16Tests.hs +0/−225
- test/Internal.hs +203/−0
- test/Main.hs +245/−0
CHANGELOG.md view
@@ -1,5 +1,19 @@ # Revision history for base16 +## 0.3.0.0++* API for `decodeBase16With` has changed to require `ByteString` instead of `Text`. This is in alignment with work done on `base64`, which reflects+ the same API. This will be the final design for these types of conversions.+* Test coverage now at 94%+* Add NFData, Exception, and Generic instances for Base16Error + @since annotations for new instances. ([#5](https://github.com/emilypi/Base16/pull/5))+* Doc improvements and add -XTrustworty and -XSafe annotations where needed. ([#5](https://github.com/emilypi/Base16/pull/5))+* Optimized inner loop for short text and bytestrings ([#4](https://github.com/emilypi/Base16/pull/4))+* Changed `encodeBase16` in `ByteString.Short` to produce `ShortText`, instead of `Text`.++## 0.2.1++* Added support for `Text.Short` and `ByteString.Short` values+ ## 0.2.0.1 * Improved performance. Decode and encode are now 3.5x-5x the next best lib.
README.md view
@@ -21,7 +21,7 @@ Additionally this library has - Much better performance than `base16-bytestring` for encode and decode, with a more conventional api.-- Optics for handling more complex structures with Base64 representations via the `base16-lens` package+- Optics for handling more complex structures with Base16 representations via the `base16-lens` package - Checks for both validity and correctness of Base16 encodings. There are no dependencies aside from those bundled with GHC.
base16.cabal view
@@ -1,26 +1,30 @@-cabal-version: 2.0-name: base16-version: 0.2.1.0-synopsis: RFC 4648-compliant Base16 encodings/decodings+cabal-version: 2.0+name: base16+version: 0.3.0.0+synopsis: Fast RFC 4648-compliant Base16 encoding description: RFC 4648-compliant Base16 encodings and decodings. This library provides performant encoding and decoding primitives, as well as support for textual values. -homepage: https://github.com/emilypi/base16-bug-reports: https://github.com/emilypi/base16/issues-license: BSD3-license-file: LICENSE-author: Emily Pillmore-maintainer: emilypi@cohomolo.gy-copyright: (c) 2020 Emily Pillmore-category: Data-build-type: Simple-extra-source-files:+homepage: https://github.com/emilypi/base16+bug-reports: https://github.com/emilypi/base16/issues+license: BSD3+license-file: LICENSE+author: Emily Pillmore+maintainer: emilypi@cohomolo.gy+copyright: (c) 2020 Emily Pillmore+category: Data+build-type: Simple+extra-doc-files: CHANGELOG.md README.md tested-with:- GHC ==8.2.2 || ==8.4.3 || ==8.4.4 || ==8.6.3 || ==8.6.5 || ==8.8.1+ GHC ==8.2.2+ || ==8.4.4+ || ==8.6.5+ || ==8.8.3+ || ==8.10.1 source-repository head type: git@@ -40,11 +44,13 @@ Data.ByteString.Base16.Internal.Head Data.ByteString.Base16.Internal.Utils Data.ByteString.Base16.Internal.W16.Loop+ Data.ByteString.Base16.Internal.W16.ShortLoop build-depends:- base >=4.10 && <5+ base >=4.10 && <5 , bytestring ^>=0.10- , primitive+ , deepseq >=1.4.3.0 && <1.4.5.0+ , primitive >=0.6 && <0.8 , text ^>=1.2 , text-short ^>=0.1 @@ -53,20 +59,23 @@ ghc-options: -Wall test-suite tasty+ other-modules: Internal default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: test- main-is: Base16Tests.hs+ main-is: Main.hs build-depends: base >=4.10 && <5 , base16 , base16-bytestring , bytestring- , memory+ , QuickCheck , random-bytestring , tasty , tasty-hunit+ , tasty-quickcheck , text+ , text-short benchmark bench default-language: Haskell2010@@ -80,6 +89,5 @@ , bytestring , criterion , deepseq- , memory , random-bytestring , text
benchmarks/Base16Bench.hs view
@@ -7,10 +7,10 @@ import Criterion import Criterion.Main -import Data.ByteString.Lazy (fromStrict)-import "memory" Data.ByteArray.Encoding as Mem import Data.ByteString+import Data.ByteString.Short import "base16" Data.ByteString.Base16 as B16+import "base16" Data.ByteString.Short.Base16 as BS16 import "base16-bytestring" Data.ByteString.Base16 as Bos import Data.ByteString.Random (random) @@ -21,32 +21,32 @@ [ env bs $ \ ~((bs25,bs100,bs1k,bs10k,bs100k,bs1mm),(bs25L,bs100L,bs1kL,bs10kL,bs100kL,bs1mmL)) -> bgroup "encode" [ bgroup "25"- [ bench "memory" $ whnf ctob bs25+ [ bench "base16-short" $ whnf BS16.encodeBase16' bs25L , bench "base16-bytestring" $ whnf Bos.encode bs25 , bench "base16" $ whnf B16.encodeBase16' bs25 ] , bgroup "100"- [ bench "memory" $ whnf ctob bs100+ [ bench "base16-short" $ whnf BS16.encodeBase16' bs100L , bench "base16-bytestring" $ whnf Bos.encode bs100 , bench "base16" $ whnf B16.encodeBase16' bs100 ] , bgroup "1k"- [ bench "memory" $ whnf ctob bs1k+ [ bench "base16-short" $ whnf BS16.encodeBase16' bs1kL , bench "base16-bytestring" $ whnf Bos.encode bs1k , bench "base16" $ whnf B16.encodeBase16' bs1k ] , bgroup "10k"- [ bench "memory" $ whnf ctob bs10k+ [ bench "base16-short" $ whnf BS16.encodeBase16' bs10kL , bench "base16-bytestring" $ whnf Bos.encode bs10k , bench "base16" $ whnf B16.encodeBase16' bs10k ] , bgroup "100k"- [ bench "memory" $ whnf ctob bs100k+ [ bench "base16-short" $ whnf BS16.encodeBase16' bs100kL , bench "base16-bytestring" $ whnf Bos.encode bs100k , bench "base16" $ whnf B16.encodeBase16' bs100k ] , bgroup "1mm"- [ bench "memory" $ whnf ctob bs1mm+ [ bench "base16-short" $ whnf BS16.encodeBase16' bs1mmL , bench "base16-bytestring" $ whnf Bos.encode bs1mm , bench "base16" $ whnf B16.encodeBase16' bs1mm ]@@ -54,44 +54,38 @@ , env bs' $ \ ~((bs25,bs100,bs1k,bs10k,bs100k,bs1mm),(bs25L,bs100L,bs1kL,bs10kL,bs100kL,bs1mmL)) -> bgroup "decode" [ bgroup "25"- [ bench "memory" $ whnf cfob bs25+ [ bench "base16-short" $ whnf BS16.decodeBase16 bs25L , bench "base16-bytestring" $ whnf Bos.decode bs25- , bench "base16" $ whnf B16.decodeBase16Lenient bs25+ , bench "base16" $ whnf B16.decodeBase16 bs25 ] , bgroup "100"- [ bench "memory" $ whnf cfob bs100+ [ bench "base16-short" $ whnf BS16.decodeBase16 bs100L , bench "base16-bytestring" $ whnf Bos.decode bs100- , bench "base16" $ whnf B16.decodeBase16Lenient bs100+ , bench "base16" $ whnf B16.decodeBase16 bs100 ] , bgroup "1k"- [ bench "memory" $ whnf cfob bs1k+ [ bench "base16-short" $ whnf BS16.decodeBase16 bs1kL , bench "base16-bytestring" $ whnf Bos.decode bs1k- , bench "base16" $ whnf B16.decodeBase16Lenient bs1k+ , bench "base16" $ whnf B16.decodeBase16 bs1k ] , bgroup "10k"- [ bench "memory" $ whnf cfob bs10k+ [ bench "base16-short" $ whnf BS16.decodeBase16 bs10kL , bench "base16-bytestring" $ whnf Bos.decode bs10k- , bench "base16" $ whnf B16.decodeBase16Lenient bs10k+ , bench "base16" $ whnf B16.decodeBase16 bs10k ] , bgroup "100k"- [ bench "memory" $ whnf cfob bs100k+ [ bench "base16-short" $ whnf BS16.decodeBase16 bs100kL , bench "base16-bytestring" $ whnf Bos.decode bs100k- , bench "base16" $ whnf B16.decodeBase16Lenient bs100k+ , bench "base16" $ whnf B16.decodeBase16 bs100k ] , bgroup "1mm"- [ bench "memory" $ whnf cfob bs1mm+ [ bench "base16-short" $ whnf BS16.decodeBase16 bs1mmL , bench "base16-bytestring" $ whnf Bos.decode bs1mm- , bench "base16" $ whnf B16.decodeBase16Lenient bs1mm+ , bench "base16" $ whnf B16.decodeBase16 bs1mm ] ] ] where- ctob :: ByteString -> ByteString- ctob = Mem.convertToBase Mem.Base16-- cfob :: ByteString -> Either String ByteString- cfob = Mem.convertFromBase Mem.Base16- bs = do a <- random 25 b <- random 100@@ -99,13 +93,13 @@ d <- random 10000 e <- random 100000 f <- random 1000000- return ((a,b,c,d,e,f),(fromStrict a,fromStrict b,fromStrict c,fromStrict d,fromStrict e,fromStrict f))+ return ((a,b,c,d,e,f),(toShort a,toShort b,toShort c,toShort d,toShort e,toShort f)) bs' = do- a <- ctob <$> random 25- b <- ctob <$> random 100- c <- ctob <$> random 1000- d <- ctob <$> random 10000- e <- ctob <$> random 100000- f <- ctob <$> random 1000000- return ((a,b,c,d,e,f),(fromStrict a,fromStrict b,fromStrict c,fromStrict d,fromStrict e,fromStrict f))+ a <- B16.encodeBase16' <$> random 25+ b <- B16.encodeBase16' <$> random 100+ c <- B16.encodeBase16' <$> random 1000+ d <- B16.encodeBase16' <$> random 10000+ e <- B16.encodeBase16' <$> random 100000+ f <- B16.encodeBase16' <$> random 1000000+ return ((a,b,c,d,e,f),(toShort a,toShort b,toShort c,toShort d,toShort e,toShort f))
src/Data/ByteString/Base16.hs view
@@ -1,18 +1,18 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-} -- | -- Module : Data.ByteString.Base16--- Copyright : (c) 2020 Emily Pillmore--- License : BSD-style+-- Copyright : (c) 2020 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : stable+-- Portability : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base16 encoding including--- unpadded and lenient variants for bytestrings+-- This module contains 'Data.ByteString.ByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.ByteString.Base16 ( encodeBase16@@ -37,6 +37,11 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: ByteString -> Text encodeBase16 = T.decodeUtf8 . encodeBase16' {-# INLINE encodeBase16 #-}@@ -45,6 +50,11 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16' "Sun"+-- "53756e"+-- encodeBase16' :: ByteString -> ByteString encodeBase16' = encodeBase16_ {-# INLINE encodeBase16' #-}@@ -53,6 +63,14 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: ByteString -> Either Text ByteString decodeBase16 = decodeBase16_ {-# INLINE decodeBase16 #-}@@ -62,23 +80,25 @@ -- -- N.B.: this is not RFC 4648-compliant --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: ByteString -> ByteString decodeBase16Lenient = decodeBase16Lenient_ {-# INLINE decodeBase16Lenient #-} -- | Tell whether a 'ByteString' value is base16 encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -92,17 +112,10 @@ -- only that it conforms to the correct alphabet. To check whether it is a true -- Base16 encoded 'ByteString' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/ByteString/Base16/Internal/Head.hs view
@@ -7,19 +7,28 @@ ( encodeBase16_ , decodeBase16_ , decodeBase16Lenient_+, encodeBase16Short_+, decodeBase16Short_+, decodeBase16ShortLenient_ ) where #include "MachDeps.h" -import Data.ByteString (empty)+import qualified Data.ByteString as BS (empty) import Data.ByteString.Internal+import qualified Data.ByteString.Short as SBS (empty)+import Data.ByteString.Base16.Internal.Utils import Data.ByteString.Base16.Internal.W16.Loop+import qualified Data.ByteString.Base16.Internal.W16.ShortLoop as Short+import Data.ByteString.Short.Internal (ShortByteString(..))+import Data.Primitive.ByteArray import Data.Text (Text) import Foreign.Ptr import Foreign.ForeignPtr +import GHC.Exts import GHC.ForeignPtr import System.IO.Unsafe@@ -37,10 +46,11 @@ (plusPtr sptr (soff + slen)) where !dlen = 2 * slen+{-# INLINE encodeBase16_ #-} decodeBase16_ :: ByteString -> Either Text ByteString decodeBase16_ (PS !sfp !soff !slen)- | slen == 0 = Right ""+ | slen == 0 = Right BS.empty | r /= 0 = Left "invalid bytestring size" | otherwise = unsafeDupablePerformIO $ do dfp <- mallocPlainForeignPtrBytes q@@ -53,13 +63,15 @@ (plusPtr sptr (soff + slen)) 0 where- (!q, !r) = slen `divMod` 2+ !q = slen `quot` 2+ !r = slen `rem` 2+{-# INLINE decodeBase16_ #-} decodeBase16Lenient_ :: ByteString -> ByteString decodeBase16Lenient_ (PS !sfp !soff !slen)- | slen == 0 = empty+ | slen == 0 = BS.empty | otherwise = unsafeDupablePerformIO $ do- dfp <- mallocPlainForeignPtrBytes dlen+ dfp <- mallocPlainForeignPtrBytes q withForeignPtr dfp $ \dptr -> withForeignPtr sfp $ \sptr -> lenientLoop@@ -69,5 +81,44 @@ (plusPtr sptr (soff + slen)) 0 where- (!q, _) = slen `divMod` 2- !dlen = q * 2+ !q = slen `quot` 2+{-# INLINE decodeBase16Lenient_ #-}++-- ---------------------------------------------------------------- --+-- Short encode/decode++encodeBase16Short_ :: ShortByteString -> ShortByteString+encodeBase16Short_ (SBS !ba#) = runShortST $ do+ dst <- newByteArray l'+ Short.innerLoop l dst (MutableByteArray (unsafeCoerce# ba#))+ unsafeFreezeByteArray dst+ where+ !l = I# (sizeofByteArray# ba#)+ !l' = l * 2+{-# INLINE encodeBase16Short_ #-}++decodeBase16Short_ :: ShortByteString -> Either Text ShortByteString+decodeBase16Short_ (SBS !ba#)+ | l == 0 = Right SBS.empty+ | r /= 0 = Left "invalid bytestring size"+ | otherwise = runDecodeST $ do+ dst <- newByteArray q+ Short.decodeLoop l dst (MutableByteArray (unsafeCoerce# ba#))+ where+ !l = I# (sizeofByteArray# ba#)+ !q = l `quot` 2+ !r = l `rem` 2+{-# INLINE decodeBase16Short_ #-}++decodeBase16ShortLenient_ :: ShortByteString -> ShortByteString+decodeBase16ShortLenient_ (SBS !ba#)+ | l == 0 = SBS.empty+ | otherwise = runShortST $ do+ dst <- newByteArray q+ q' <- Short.lenientLoop l dst (MutableByteArray (unsafeCoerce# ba#))+ !_ <- resizeMutableByteArray dst q'+ unsafeFreezeByteArray dst+ where+ !l = I# (sizeofByteArray# ba#)+ !q = l `quot` 2+{-# INLINE decodeBase16ShortLenient_ #-}
src/Data/ByteString/Base16/Internal/Utils.hs view
@@ -1,15 +1,24 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UnboxedTuples #-} module Data.ByteString.Base16.Internal.Utils ( aix , reChunk+, runShortST+, runDecodeST ) where + import Data.ByteString (ByteString) import qualified Data.ByteString as B+import Data.ByteString.Short.Internal+import Data.Primitive.ByteArray+import Data.Text (Text) import GHC.Exts import GHC.Word+import GHC.ST (ST(..)) -- | Read 'Word8' index off alphabet addr@@ -36,3 +45,27 @@ let as' = if B.null y then as else y:as in q' : reChunk as' else cont_ q' as++-- | Write a byte array directly to Short bytestring+--+runShortST :: (forall s. ST s ByteArray) -> ShortByteString+runShortST enc = runRW# $ \s0 -> case enc of+ { ST g -> case g s0 of+ { (# _, ByteArray r #) -> SBS r+ }+ }+{-# INLINE runShortST #-}++-- | Used for writing 'ByteArray#'-based encodes+--+runDecodeST+ :: (forall s. ST s (Either Text ByteArray))+ -> Either Text ShortByteString+runDecodeST dec = runRW# $ \s0 -> case dec of+ { ST g -> case g s0 of+ { (# _, e #) -> case e of+ Left t -> Left t+ Right (ByteArray r) -> Right (SBS r)+ }+ }+{-# INLINE runDecodeST #-}
+ src/Data/ByteString/Base16/Internal/W16/ShortLoop.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+module Data.ByteString.Base16.Internal.W16.ShortLoop+( innerLoop+, decodeLoop+, lenientLoop+) where+++import Control.Monad.ST++import Data.Bits+import Data.ByteString.Base16.Internal.Utils+import Data.Primitive.ByteArray+import Data.Text (Text)+import qualified Data.Text as T+++innerLoop+ :: Int+ -> MutableByteArray s+ -> MutableByteArray s+ -> ST s ()+innerLoop !slen !dst !src = go (0 :: Int) (0 :: Int)+ where+ !hex = "0123456789abcdef"#++ go !doff !soff+ | soff == slen = return ()+ | otherwise = do+ x <- readByteArray src soff+ writeByteArray dst doff (aix (unsafeShiftR x 4) hex)+ writeByteArray dst (doff + 1) (aix (x .&. 0x0f) hex)+ go (doff + 2) (soff + 1)+{-# inline innerLoop #-}++decodeLoop+ :: Int+ -> MutableByteArray s+ -> MutableByteArray s+ -> ST s (Either Text ByteArray)+decodeLoop !slen !dst !src = go (0 :: Int) (0 :: Int)+ where+ err i = return . Left . T.pack+ $ "invalid character at offset: "+ ++ show i++ !lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++ !hi = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++ go !doff !soff+ | soff == slen = Right <$> unsafeFreezeByteArray dst+ | otherwise = do+ x <- readByteArray src soff+ y <- readByteArray src (soff + 1)++ let !a = aix x hi+ !b = aix y lo++ if+ | a == 0xff -> err soff+ | b == 0xff -> err (soff + 1)+ | otherwise -> do+ writeByteArray dst doff (a .|. b)+ go (doff + 1) (soff + 2)+{-# inline decodeLoop #-}++lenientLoop+ :: Int+ -> MutableByteArray s+ -> MutableByteArray s+ -> ST s Int+lenientLoop !slen !dst !src = goHi (0 :: Int) (0 :: Int)+ where+ !lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++ !hi = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++ goHi !doff !soff+ | soff == slen = return doff+ | otherwise = do+ x <- readByteArray src soff++ let !a = aix x hi++ if a == 0xff+ then goHi doff (soff + 1)+ else goLo doff (soff + 1) a++ goLo !doff !soff !a+ | soff == slen = return doff+ | otherwise = do+ y <- readByteArray src soff++ let !b = aix y lo++ if b == 0xff+ then goLo doff (soff + 1) a+ else do+ writeByteArray dst doff (a .|. b)+ goHi (doff + 1) (soff + 1)+{-# inline lenientLoop #-}
src/Data/ByteString/Lazy/Base16.hs view
@@ -1,16 +1,18 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-} -- |--- Module : Data.ByteString.Base16.Lazy--- Copyright : (c) 2020 Emily Pillmore--- License : BSD-style+-- Module : Data.ByteString.Lazy.Base16+-- Copyright : (c) 2020 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : stable+-- Portability : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base16 encoding including--- unpadded and lenient variants for lazy bytestrings+-- This module contains 'Data.ByteString.Lazy.ByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.ByteString.Lazy.Base16 ( encodeBase16@@ -40,6 +42,11 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: ByteString -> Text encodeBase16 = TL.decodeUtf8 . encodeBase16' {-# INLINE encodeBase16 #-}@@ -48,6 +55,11 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16' "Sun"+-- "53756e"+-- encodeBase16' :: ByteString -> ByteString encodeBase16' Empty = Empty encodeBase16' (Chunk b bs) = Chunk (B16.encodeBase16_ b) (encodeBase16' bs)@@ -57,6 +69,14 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: ByteString -> Either T.Text ByteString decodeBase16 Empty = Right Empty decodeBase16 (Chunk b bs) = Chunk <$> B16.decodeBase16_ b <*> decodeBase16 bs@@ -67,6 +87,14 @@ -- -- N.B.: this is not RFC 4648-compliant. It may give you garbage if you're not careful! --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: ByteString -> ByteString decodeBase16Lenient = fromChunks . fmap B16.decodeBase16Lenient_@@ -77,17 +105,11 @@ -- | Tell whether a lazy 'ByteString' value is base16 encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -101,17 +123,10 @@ -- only that it conforms to the correct alphabet. To check whether it is a true -- Base16 encoded 'ByteString' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/ByteString/Short/Base16.hs view
@@ -1,18 +1,18 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-} -- | -- Module : Data.ByteString.Short.Base16--- Copyright : (c) 2020 Emily Pillmore--- License : BSD-style+-- Copyright : (c) 2020 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : stable+-- Portability : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base16 encoding including--- unpadded and lenient variants for bytestrings+-- This module contains 'Data.ByteString.Short.ShortByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.ByteString.Short.Base16 ( encodeBase16@@ -24,35 +24,56 @@ ) where -import Prelude hiding (all, elem)--import Data.ByteString.Short (ShortByteString, toShort, fromShort)+import Data.ByteString.Short (ShortByteString, fromShort)+import Data.ByteString.Base16.Internal.Head import qualified Data.ByteString.Base16 as B16 import Data.Text (Text)+import Data.Text.Short (ShortText)+import Data.Text.Short.Unsafe --- | Encode a 'ShortByteString' value as Base16 'Text' with padding.+-- | Encode a 'ShortByteString' value as Base16 'ShortText' with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> ---encodeBase16 :: ShortByteString -> Text-encodeBase16 = B16.encodeBase16 . fromShort+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+--+-- @since 0.3.0.0+--+encodeBase16 :: ShortByteString -> ShortText+encodeBase16 = fromShortByteStringUnsafe . decodeBase16ShortLenient_ {-# INLINE encodeBase16 #-} -- | Encode a 'ShortByteString' value as a Base16 'ShortByteString' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16' "Sun"+-- "53756e"+-- encodeBase16' :: ShortByteString -> ShortByteString-encodeBase16' = toShort . B16.encodeBase16' . fromShort+encodeBase16' = encodeBase16Short_ {-# INLINE encodeBase16' #-} -- | Decode a Base16-encoded 'ShortByteString' value. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: ShortByteString -> Either Text ShortByteString-decodeBase16 = fmap toShort . B16.decodeBase16 . fromShort+decodeBase16 = decodeBase16Short_ {-# INLINE decodeBase16 #-} -- | Decode a Base16-encoded 'ShortByteString' value leniently, using a@@ -60,23 +81,26 @@ -- -- N.B.: this is not RFC 4648-compliant --+--+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: ShortByteString -> ShortByteString-decodeBase16Lenient = toShort . B16.decodeBase16Lenient . fromShort+decodeBase16Lenient = decodeBase16ShortLenient_ {-# INLINE decodeBase16Lenient #-} -- | Tell whether a 'ShortByteString' value is base16 encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -90,17 +114,10 @@ -- only that it conforms to the correct alphabet. To check whether it is a true -- Base16 encoded 'ShortByteString' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/Text/Encoding/Base16.hs view
@@ -1,15 +1,17 @@+{-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Encoding.Base16--- Copyright : (c) 2019 Emily Pillmore--- License : BSD-style+-- Copyright : (c) 2020 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : stable+-- Portability : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base16 encoding including--- unpadded and lenient variants for text values+-- This module contains 'Data.Text.Text'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.Text.Encoding.Base16 ( encodeBase16@@ -29,10 +31,16 @@ import Data.Text.Encoding.Base16.Error (Base16Error(..)) import qualified Data.Text.Encoding as T + -- | Encode a 'Text' value in Base16 with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: Text -> Text encodeBase16 = B16.encodeBase16 . T.encodeUtf8 {-# INLINE encodeBase16 #-}@@ -41,6 +49,14 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: Text -> Either T.Text Text decodeBase16 = fmap T.decodeLatin1 . B16.decodeBase16 . T.encodeUtf8 {-# INLINE decodeBase16 #-}@@ -51,20 +67,22 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> ----- Example:+-- === __Example__: -- -- @ -- 'decodeBase16With' 'T.decodeUtf8''--- :: 'Text' -> 'Either' ('Base16Error' 'UnicodeException') 'Text'+-- :: 'ByteString' -> 'Either' ('Base16Error' 'UnicodeException') 'Text' -- @ --+-- @since 0.3.0.0+-- decodeBase16With :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')- -> Text- -- ^ Input text to decode+ -> ByteString+ -- ^ Input to decode -> Either (Base16Error err) Text-decodeBase16With f t = case B16.decodeBase16 $ T.encodeUtf8 t of+decodeBase16With f t = case B16.decodeBase16 t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase16With #-}@@ -75,23 +93,25 @@ -- -- N.B.: this is not RFC 4648-compliant. --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: Text -> Text decodeBase16Lenient = T.decodeLatin1 . B16.decodeBase16Lenient . T.encodeUtf8 {-# INLINE decodeBase16Lenient #-} -- | Tell whether a 'Text' value is Base16-encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -105,17 +125,10 @@ -- only that it conforms to the correct shape. To check whether it is a true -- Base16 encoded 'Text' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/Text/Encoding/Base16/Error.hs view
@@ -1,13 +1,15 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Encoding.Base16.Error--- Copyright : (c) 2019 Emily Pillmore--- License : BSD-style+-- Copyright : (c) 2019 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable ----- This module contains the error types raised (not as exceptions!)+-- This module contains the error types raised -- in the decoding process. -- module Data.Text.Encoding.Base16.Error@@ -15,8 +17,14 @@ ) where +import Control.DeepSeq (NFData(..))+import Control.Exception (Exception(..))+ import Data.Text (Text) +import GHC.Generics++ -- | This data type represents the type of decoding errors of -- various kinds as they pertain to decoding 'Text' values. -- Namely, to distinguish between decoding errors from opaque@@ -29,4 +37,21 @@ | ConversionError e -- ^ The error associated with the decoding failure -- as a result of the conversion process- deriving (Eq, Show)+ deriving+ ( Eq, Show+ , Generic+ -- ^ @since 0.3.0.0+ )++-- |+--+-- @since 0.3.0.0+--+instance Exception e => Exception (Base16Error e)+++-- |+--+-- @since 0.3.0.0+--+instance NFData e => NFData (Base16Error e)
src/Data/Text/Lazy/Encoding/Base16.hs view
@@ -1,15 +1,17 @@+{-# LANGUAGE Safe #-} -- | -- Module : Data.Text.Encoding.Base16.Lazy--- Copyright : (c) 2019 Emily Pillmore--- License : BSD-style+-- Copyright : (c) 2020 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : stable+-- Portability : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base16 encoding including--- unpadded and lenient variants for lazy textual values+-- This module contains 'Data.Text.Lazy.Text'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.Text.Lazy.Encoding.Base16 ( encodeBase16@@ -29,10 +31,16 @@ import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.Encoding as TL + -- | Encode a lazy 'Text' value in Base16 with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: Text -> Text encodeBase16 = B16L.encodeBase16 . TL.encodeUtf8 {-# INLINE encodeBase16 #-}@@ -41,6 +49,14 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: Text -> Either T.Text Text decodeBase16 = fmap TL.decodeLatin1 . B16L.decodeBase16 . TL.encodeUtf8 {-# INLINE decodeBase16 #-}@@ -51,20 +67,20 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> ----- Example:--- -- @--- 'decodeBase16With' 'T.decodeUtf8''--- :: 'Text' -> 'Either' ('Base16Error' 'UnicodeException') 'Text'+-- 'decodeBase16With' 'TL.decodeUtf8''+-- :: 'ByteString' -> 'Either' ('Base16Error' 'UnicodeException') 'Text' -- @ --+-- @since 0.3.0.0+-- decodeBase16With :: (ByteString -> Either err Text) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')- -> Text- -- ^ Input text to decode+ -> ByteString+ -- ^ Input to decode -> Either (Base16Error err) Text-decodeBase16With f t = case B16L.decodeBase16 $ TL.encodeUtf8 t of+decodeBase16With f t = case B16L.decodeBase16 t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase16With #-}@@ -78,28 +94,31 @@ -- -- N.B.: this is not RFC 4648-compliant. It may give you garbage if you're not careful! --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: Text -> Text decodeBase16Lenient = TL.decodeLatin1 . B16L.decodeBase16Lenient . TL.encodeUtf8 {-# INLINE decodeBase16Lenient #-} -- | Tell whether a lazy 'Text' value is Base16-encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True -- isBase16 :: Text -> Bool isBase16 = B16L.isBase16 . TL.encodeUtf8+ {-# INLINE isBase16 #-} -- | Tell whether a lazy 'Text' value is a valid Base16 format.@@ -108,17 +127,10 @@ -- only that it conforms to the correct shape. To check whether it is a true -- Base16 encoded 'Text' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/Text/Short/Encoding/Base16.hs view
@@ -1,15 +1,17 @@+{-# LANGUAGE Trustworthy #-} -- | -- Module : Data.Text.Short.Encoding.Base16--- Copyright : (c) 2019 Emily Pillmore--- License : BSD-style+-- Copyright : (c) 2020 Emily Pillmore+-- License : BSD-style ----- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>--- Stability : Experimental--- Portability : portable+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : stable+-- Portability : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base16 encoding including--- unpadded and lenient variants for text values+-- This module contains 'Data.Text.Short.ShortText'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.Text.Short.Encoding.Base16 ( encodeBase16@@ -23,10 +25,9 @@ import Data.Bifunctor (first) import qualified Data.ByteString.Base16 as B16-import Data.ByteString.Short (ShortByteString)+import Data.ByteString.Short import qualified Data.ByteString.Short.Base16 as BS16 import Data.Text (Text)-import qualified Data.Text.Encoding.Base16 as B16T import Data.Text.Encoding.Base16.Error import Data.Text.Short import Data.Text.Short.Unsafe@@ -36,65 +37,88 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: ShortText -> ShortText-encodeBase16 = fromByteStringUnsafe . B16.encodeBase16' . toByteString+encodeBase16 = fromShortByteStringUnsafe+ . BS16.encodeBase16'+ . toShortByteString {-# INLINE encodeBase16 #-} --- | Decode a Base16-encoded lazy 'ShortText' value.+-- | Decode a Base16-encoded 'ShortText' value. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: ShortText -> Either Text ShortText-decodeBase16 = fmap fromText . B16T.decodeBase16 . toText+decodeBase16 = fmap fromShortByteStringUnsafe+ . BS16.decodeBase16+ . toShortByteString {-# INLINE decodeBase16 #-} --- | Attempt to decode a lazy 'ShortText' value as Base16, converting from+-- | Attempt to decode a 'ShortText' value as Base16, converting from -- 'ByteString' to 'ShortText' according to some encoding function. In practice, -- This is something like 'decodeUtf8'', which may produce an error. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> ----- Example:+-- === __Example__: -- -- @--- 'decodeBase16With' 'T.decodeUtf8''--- :: 'ShortText' -> 'Either' ('Base16Error' 'UnicodeException') 'ShortText'+-- 'decodeBase16With' (fmap 'fromText' . 'Data.Text.Encoding.decodeUtf8'' . 'fromShort')+-- :: 'ShortByteString' -> 'Either' ('Base16Error' 'UnicodeException') 'ShortText' -- @ --+-- @since 0.3.0.0+-- decodeBase16With :: (ShortByteString -> Either err ShortText) -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')- -> ShortText- -- ^ Input text to decode+ -> ShortByteString+ -- ^ Input to decode -> Either (Base16Error err) ShortText-decodeBase16With f t = case BS16.decodeBase16 (toShortByteString t) of+decodeBase16With f t = case BS16.decodeBase16 t of Left de -> Left $ DecodeError de Right a -> first ConversionError (f a) {-# INLINE decodeBase16With #-} --- | Decode a Base16-encoded lazy 'ShortText' value leniently, using a+-- | Decode a Base16-encoded 'ShortText' value leniently, using a -- strategy that never fails, catching unicode exceptions raised in the -- process of converting to text values. -- -- N.B.: this is not RFC 4648-compliant. --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: ShortText -> ShortText-decodeBase16Lenient = fromText . B16T.decodeBase16Lenient . toText+decodeBase16Lenient = fromShortByteStringUnsafe+ . BS16.decodeBase16Lenient+ . toShortByteString {-# INLINE decodeBase16Lenient #-} -- | Tell whether a 'ShortText' value is Base16-encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -108,17 +132,10 @@ -- only that it conforms to the correct shape. To check whether it is a true -- Base16 encoded 'ShortText' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
− test/Base16Tests.hs
@@ -1,225 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE TypeApplications #-}-module Main-( main-, tests-) where---import Data.Bifunctor-import Data.ByteString (ByteString)-import Data.ByteString.Lazy (fromStrict, toStrict)-import "base16" Data.ByteString.Base16 as B16-import "base16" Data.ByteString.Lazy.Base16 as B16L-import "memory" Data.ByteArray.Encoding as Mem-import Data.ByteString.Random (random)-import Data.Functor (void)-import Data.Text (pack)--import Test.Tasty-import Test.Tasty.HUnit---main :: IO ()-main = defaultMain tests---tests :: TestTree-tests = testGroup "Base16 Tests"- [ testVectors- , sanityTests- , alphabetTests- , lenientTests- ]--testVectors :: TestTree-testVectors = testGroup "RFC 4648 Test Vectors"- [ testGroup "strict encode/decode"- [ testCaseB16 "" ""- , testCaseB16 "f" "66"- , testCaseB16 "fo" "666f"- , testCaseB16 "foo" "666f6f"- , testCaseB16 "foob" "666f6f62"- , testCaseB16 "fooba" "666f6f6261"- , testCaseB16 "foobar" "666f6f626172"- ]- , testGroup "lazy encode/decode"- [ testCaseB16L "" ""- , testCaseB16L "f" "66"- , testCaseB16L "fo" "666f"- , testCaseB16L "foo" "666f6f"- , testCaseB16L "foob" "666f6f62"- , testCaseB16L "fooba" "666f6f6261"- , testCaseB16L "foobar" "666f6f626172"- ]- ]- where- testCaseB16 s t =- testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do- let t' = B16.encodeBase16' s- s' = B16.decodeBase16 t'-- step "compare encoding"- t @=? t'-- step "compare decoding"- Right s @=? s'-- testCaseB16L s t =- testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do- let t' = B16L.encodeBase16' s- s' = B16L.decodeBase16 t'-- step "compare encoding"- t @=? t'-- step "compare decoding"- Right s @=? s'--sanityTests :: TestTree-sanityTests = testGroup "Sanity tests"- [ testGroup "strict"- [ testGroup "very large bytestrings don't segfault"- [ chonk- ]- , testGroup "`memory` sanity checks"- [ compare 3- , compare 4- , compare 5- , compare 6- , compare 1000- , compare 100000- ]- , testGroup "roundtrip encode/decode"- [ roundtrip 3- , roundtrip 4- , roundtrip 5- , roundtrip 1000- , roundtrip 100000- ]- ]- , testGroup "lazy"- [ testGroup "very large bytestrings don't segfault"- [ chonkL- ]- , testGroup "`memory` sanity checks"- [ compareL 3- , compareL 4- , compareL 5- , compareL 6- , compareL 1000- , compareL 100000- ]- , testGroup "roundtrip encode/decode"- [ roundtripL 3- , roundtripL 4- , roundtripL 5- , roundtripL 1000- , roundtripL 100000- ]- ]- ]- where- chonk = testCase ("Encoding huge bytestrings doesn't result in OOM or segfault") $ do- bs <- random 1000000- void $ return $ B16.encodeBase16' bs-- chonkL = testCase ("Encoding huge bytestrings doesn't result in OOM or segfault") $ do- bs <- fromStrict <$> random 1000000- void $ return $ B16L.encodeBase16' bs-- compare n = testCase ("Testing " ++ show n ++ "-sized bytestrings") $ do- bs <- random n- B16.encodeBase16' bs @=? Mem.convertToBase Mem.Base16 bs-- B16.decodeBase16 (B16.encodeBase16' bs) @=?- first pack (Mem.convertFromBase @ByteString Mem.Base16 (Mem.convertToBase Mem.Base16 bs))-- compareL n = testCase ("Testing " ++ show n ++ "-sized bytestrings") $ do- bs <- random n- B16L.encodeBase16' (fromStrict bs) @=? fromStrict (Mem.convertToBase Mem.Base16 bs)-- B16L.decodeBase16 (B16L.encodeBase16' (fromStrict bs)) @=?- bimap pack fromStrict (Mem.convertFromBase @ByteString Mem.Base16 (Mem.convertToBase Mem.Base16 bs))-- roundtrip n = testCase ("Roundtrip encode/decode for " ++ show n ++ "-sized bytestrings") $ do- bs <- random n- B16.decodeBase16 (B16.encodeBase16' bs) @=? Right bs-- roundtripL n = testCase ("Roundtrip encode/decode for " ++ show n ++ "-sized bytestrings") $ do- bs <- fromStrict <$> random n- B16L.decodeBase16 (B16L.encodeBase16' bs) @=? Right bs--alphabetTests :: TestTree-alphabetTests = testGroup "Alphabet tests"- [ testGroup "Strict"- [ conforms 0- , conforms 4- , conforms 5- , conforms 6- , conforms 32- , conforms 33- , conforms 1001- ]- , testGroup "Lazy"- [ conformsL 0- , conformsL 4- , conformsL 5- , conformsL 6- , conformsL 32- , conformsL 33- , conformsL 1001- ]- ]- where- conforms n = testCase ("Conforms to Base16 alphabet: " ++ show n) $ do- bs <- random n- let b = B16.encodeBase16' bs- assertBool ("failed validity: " ++ show b) $ B16.isValidBase16 b- assertBool ("failed correctness: " ++ show b) $ B16.isBase16 b-- conformsL n = testCase ("Conforms to Base16 alphabet: " ++ show n) $ do- bs <- fromStrict <$> random n- let b = B16L.encodeBase16' bs- assertBool ("failed validity: " ++ show b) $ B16L.isValidBase16 b- assertBool ("failed correctness: " ++ show b) $ B16L.isBase16 b--lenientTests :: TestTree-lenientTests = testGroup "Lenient Tests"- [ testGroup "strict encode/lenient decode"- [ testCaseB16 "" ""- , testCaseB16 "f" "6+6"- , testCaseB16 "fo" "6$6+6|f"- , testCaseB16 "foo" "==========6$$66()*f6f"- , testCaseB16 "foob" "66^%$&^6f6f62"- , testCaseB16 "fooba" "666f()*#@6f#)(@*)6()*)2()61"- , testCaseB16 "foobar" "6@6@6@f@6@f@6@2@6@1@7@2++++++++++++++++++++++++"- ]- , testGroup "lazy encode/decode"- [ testCaseB16L "" ""- , testCaseB16L "f" "6+++++++____++++++======*%$@#%#^*$^6"- , testCaseB16L "fo" "6$6+6|f"- , testCaseB16L "foo" "==========6$$66()*f6f"- , testCaseB16L "foob" "66^%$&^6f6f62"- , testCaseB16L "fooba" "666f()*#@6f#)(@*)6()*)2()61"- , testCaseB16L "foobar" "6@6@6@f@6@f@6@2@6@1@7@2++++++++++++++++++++++++"- ]- ]- where- testCaseB16 s t =- testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do- let t0 = B16.decodeBase16 (B16.encodeBase16' s)- t1 = B16.decodeBase16Lenient t-- step "compare decoding"- t0 @=? Right t1-- testCaseB16L s t =- testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do- let t0 = fmap toStrict $ B16L.decodeBase16 (B16L.encodeBase16' s)- t1 = Right . toStrict $ B16L.decodeBase16Lenient t-- step "compare decoding"- t0 @=? t1
+ test/Internal.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module : Main+-- Copyright : (c) 2020 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- This module contains internal test harnesses for `base16`+--+module Internal where+++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Short as SBS+import "base16" Data.ByteString.Base16 as B16+import "base16" Data.ByteString.Lazy.Base16 as LB16+import "base16" Data.ByteString.Short.Base16 as SB16+import Data.Proxy+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import "base16" Data.Text.Encoding.Base16 as T16+import Data.Text.Encoding.Base16.Error (Base16Error(..))+import qualified Data.Text.Lazy as TL+import "base16" Data.Text.Lazy.Encoding.Base16 as TL16+import qualified Data.Text.Short as TS+import "base16" Data.Text.Short.Encoding.Base16 as TS16++import Test.QuickCheck hiding (label)++-- ------------------------------------------------------------------ --+-- Test Harnesses++data Impl+ = B16+ | LB16+ | SB16+ | T16+ | TL16+ | TS16++b16 :: Proxy 'B16+b16 = Proxy++lb16 :: Proxy 'LB16+lb16 = Proxy++sb16 :: Proxy 'SB16+sb16 = Proxy++t16 :: Proxy 'T16+t16 = Proxy++tl16 :: Proxy 'TL16+tl16 = Proxy++ts16 :: Proxy 'TS16+ts16 = Proxy++-- | This class provides the generic API definition for+-- the base16 std alphabet+--+class+ ( Eq bs+ , Show bs+ , Arbitrary bs+ , CoArbitrary bs+ , IsString bs+ ) => Harness (a :: Impl) bs | a -> bs, bs -> a+ where++ label :: String+ encode :: bs -> bs+ decode :: bs -> Either Text bs+ lenient :: bs -> bs++ correct :: bs -> Bool+ validate :: bs -> Bool+++instance Harness 'B16 BS.ByteString where+ label = "ByteString"++ encode = B16.encodeBase16'+ decode = B16.decodeBase16+ lenient = B16.decodeBase16Lenient+ correct = B16.isBase16+ validate = B16.isValidBase16++instance Harness 'LB16 LBS.ByteString where+ label = "Lazy ByteString"++ encode = LB16.encodeBase16'+ decode = LB16.decodeBase16+ lenient = LB16.decodeBase16Lenient+ correct = LB16.isBase16+ validate = LB16.isValidBase16++instance Harness 'SB16 SBS.ShortByteString where+ label = "Short ByteString"++ encode = SB16.encodeBase16'+ decode = SB16.decodeBase16+ lenient = SB16.decodeBase16Lenient+ correct = SB16.isBase16+ validate = SB16.isValidBase16++instance Harness 'T16 Text where+ label = "Text"++ encode = T16.encodeBase16+ decode = T16.decodeBase16+ lenient = T16.decodeBase16Lenient+ correct = T16.isBase16+ validate = T16.isValidBase16++instance Harness 'TL16 TL.Text where+ label = "Lazy Text"++ encode = TL16.encodeBase16+ decode = TL16.decodeBase16+ lenient = TL16.decodeBase16Lenient+ correct = TL16.isBase16+ validate = TL16.isValidBase16++instance Harness 'TS16 TS.ShortText where+ label = "Short Text"++ encode = TS16.encodeBase16+ decode = TS16.decodeBase16+ lenient = TS16.decodeBase16Lenient+ correct = TS16.isBase16+ validate = TS16.isValidBase16++class Harness a cs+ => TextHarness (a :: Impl) cs bs+ | a -> cs, bs -> cs, cs -> a, cs -> bs where+ decodeWith_ :: (bs -> Either err cs) -> bs -> Either (Base16Error err) cs++instance TextHarness 'T16 Text BS.ByteString where+ decodeWith_ = T16.decodeBase16With++instance TextHarness 'TL16 TL.Text LBS.ByteString where+ decodeWith_ = TL16.decodeBase16With++instance TextHarness 'TS16 TS.ShortText SBS.ShortByteString where+ decodeWith_ = TS16.decodeBase16With++-- ------------------------------------------------------------------ --+-- Quickcheck instances++instance Arbitrary BS.ByteString where+ arbitrary = BS.pack <$> arbitrary+ shrink xs = BS.pack <$> shrink (BS.unpack xs)++instance CoArbitrary BS.ByteString where+ coarbitrary = coarbitrary . BS.unpack++instance Arbitrary LBS.ByteString where+ arbitrary = LBS.pack <$> arbitrary+ shrink xs = LBS.pack <$> shrink (LBS.unpack xs)++instance CoArbitrary LBS.ByteString where+ coarbitrary = coarbitrary . LBS.unpack++instance Arbitrary SBS.ShortByteString where+ arbitrary = SBS.pack <$> arbitrary+ shrink xs = SBS.pack <$> shrink (SBS.unpack xs)++instance CoArbitrary SBS.ShortByteString where+ coarbitrary = coarbitrary . SBS.unpack++instance Arbitrary T.Text where+ arbitrary = T.pack <$> arbitrary+ shrink xs = T.pack <$> shrink (T.unpack xs)++instance Arbitrary TL.Text where+ arbitrary = TL.pack <$> arbitrary+ shrink xs = TL.pack <$> shrink (TL.unpack xs)++instance CoArbitrary T.Text where+ coarbitrary = coarbitrary . T.unpack++instance CoArbitrary TL.Text where+ coarbitrary = coarbitrary . TL.unpack++instance Arbitrary TS.ShortText where+ arbitrary = TS.fromText <$> arbitrary+ shrink xs = fmap TS.fromText $ shrink (TS.toText xs)++instance CoArbitrary TS.ShortText where+ coarbitrary = coarbitrary . TS.toText
+ test/Main.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module : Main+-- Copyright : (c) 2020 Emily Pillmore+-- License : BSD-style+--+-- Maintainer : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability : Experimental+-- Portability : portable+--+-- This module contains the test implementation for the `base16` package+--+module Main+( main+, tests+) where+++import Data.Bifunctor (second)+import qualified Data.ByteString as BS+import Data.ByteString.Internal (c2w)+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Short as SBS+import "base16" Data.ByteString.Base16 as B16+import qualified "base16-bytestring" Data.ByteString.Base16 as Bos+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Text.Encoding.Base16.Error (Base16Error(..))+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Short as TS+import Data.Word++import Internal++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck (testProperty)+++main :: IO ()+main = defaultMain tests+++tests :: TestTree+tests = testGroup "Base16 Tests"+ [ mkTree b16+ [ mkPropTree+ , mkUnitTree+ ]+ , mkTree lb16+ [ mkPropTree+ , mkUnitTree+ ]+ , mkTree sb16+ [ mkPropTree+ , mkUnitTree+ ]+ , mkTree t16+ [ mkPropTree+ , mkUnitTree+ , mkDecodeTree T.decodeUtf8' b16+ ]+ , mkTree tl16+ [ mkPropTree+ , mkUnitTree+ , mkDecodeTree TL.decodeUtf8' lb16+ ]+ , mkTree ts16+ [ mkPropTree+ , mkUnitTree+ , mkDecodeTree+ (second TS.fromText . T.decodeUtf8' . SBS.fromShort) sb16+ ]+ ]++-- ---------------------------------------------------------------- --+-- Test tree generation++-- | Make a test tree for a given label+--+mkTree+ :: forall a b proxy+ . Harness a b+ => proxy a+ -> [proxy a -> TestTree]+ -> TestTree+mkTree a = testGroup (label @a) . fmap ($ a)++-- | Make a test group with some name, lifting a test tree up to the correct+-- type information via some Harness+--+mkTests+ :: forall a b proxy+ . Harness a b+ => String+ -> [proxy a -> TestTree]+ -> proxy a+ -> TestTree+mkTests context ts = testGroup context . (<*>) ts . pure++-- | Make property tests for a given harness instance+--+mkPropTree :: forall a b proxy. Harness a b => proxy a -> TestTree+mkPropTree = mkTests "Property Tests"+ [ prop_roundtrip+ , prop_correctness+ , const prop_bos_coherence+ ]++-- | Make unit tests for a given harness instance+--+mkUnitTree+ :: forall a b proxy+ . Harness a b+ => proxy a+ -> TestTree+mkUnitTree = mkTests "Unit tests"+ [ rfcVectors+ , lenientTests+ ]++-- | Make unit tests for textual 'decode*With' functions+--+mkDecodeTree+ :: forall t a b c e proxy+ . ( TextHarness a b c+ , Harness t c+ , Show e+ )+ => (c -> Either e b)+ -> proxy t+ -> proxy a+ -> TestTree+mkDecodeTree utf8 t = mkTests "Decoding tests"+ [ decodeWithVectors utf8 t+ ]++-- ---------------------------------------------------------------- --+-- Property tests++prop_roundtrip :: forall a b proxy. Harness a b => proxy a -> TestTree+prop_roundtrip _ = testGroup "prop_roundtrip"+ [ testProperty "prop_std_roundtrip" $ \(bs :: b) ->+ Right (encode bs) == decode (encode (encode bs))+ , testProperty "prop_std_lenient_roundtrip" $ \(bs :: b) ->+ encode bs == lenient (encode (encode bs))+ ]++prop_correctness :: forall a b proxy. Harness a b => proxy a -> TestTree+prop_correctness _ = testGroup "prop_validity"+ [ testProperty "prop_std_valid" $ \(bs :: b) ->+ validate (encode bs)+ , testProperty "prop_std_correct" $ \(bs :: b) ->+ correct (encode bs)+ ]++-- | just a sanity check against `base16-bytestring`+--+prop_bos_coherence :: TestTree+prop_bos_coherence = testGroup "prop_bos_coherence"+ [ testProperty "prop_std_bos_coherence" $ \bs ->+ Right bs == B16.decodeBase16 (B16.encodeBase16' bs)+ && Right bs == (Right (fst $ Bos.decode $ Bos.encode bs) :: Either T.Text BS.ByteString)+ ]++-- ---------------------------------------------------------------- --+-- Unit tests++rfcVectors :: forall a b proxy. Harness a b => proxy a -> TestTree+rfcVectors _ = testGroup "RFC 4648 Test Vectors"+ [ testCaseB16 "" ""+ , testCaseB16 "f" "66"+ , testCaseB16 "fo" "666f"+ , testCaseB16 "foo" "666f6f"+ , testCaseB16 "foob" "666f6f62"+ , testCaseB16 "fooba" "666f6f6261"+ , testCaseB16 "foobar" "666f6f626172"+ ]+ where+ testCaseB16 s t =+ testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do+ step "encode is sound"+ t @=? encode @a s++ step "decode is sound"+ Right s @=? decode (encode s)++-- | Unit test trees for the `decode*With` family of text-valued functions+--+decodeWithVectors+ :: forall t a b c e proxy+ . ( TextHarness a c b+ , Harness t b+ , Show e+ )+ => (b -> Either e c)+ -- ^ utf8+ -> proxy t+ -- ^ witness to the bytestring-ey dictionaries+ -> proxy a+ -- ^ witness to the text dictionaries+ -> TestTree+decodeWithVectors utf8 _ _ = testGroup "DecodeWith* unit tests"+ [ testGroup "decodeWith negative tests"+ [ testCase "decodeWith non-utf8 inputs on decodeUtf8" $ do+ case decodeWith_ @a utf8 "\1079743" of+ Left (DecodeError _) -> return ()+ _ -> assertFailure "decoding phase"+ , testCase "decodeWith valid utf8 inputs on decodeUtf8" $ do+ case decodeWith_ @a utf8 (encode @t "\1079743") of+ Left (ConversionError _) -> return ()+ _ -> assertFailure "conversion phase"+ ]+ , testGroup "decodeWith positive tests"+ [ testCase "decodeWith utf8 inputs on decodeUtf8" $ do+ a <- either (assertFailure . show) pure $ decode @a "666f6f626172"+ b <- either (assertFailure . show) pure $ decodeWith_ @a utf8 "666f6f626172"+ a @=? b+ ]+ ]++lenientTests :: forall a b proxy. Harness a b => proxy a -> TestTree+lenientTests _ = testGroup "Lenient Tests"+ [ testCaseB16 "" ""+ , testCaseB16 "f" "6+6"+ , testCaseB16 "fo" "6$6+6|f"+ , testCaseB16 "foo" "==========6$$66()*f6f"+ , testCaseB16 "foob" "66^%$&^6f6f62"+ , testCaseB16 "fooba" "666f()*#@6f#)(@*)6()*)2()61"+ , testCaseB16 "foobar" "6@6@6@f@6@f@6@2@6@1@7@2++++++++++++++++++++++++"+ ]+ where+ testCaseB16 s t =+ testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do+ let t0 = decode (encode @a s)+ t1 = lenient @a t++ step "compare decoding"+ t0 @=? Right t1